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

Fix CVE-2008-2827, remove old unused patches.

Browse Source
This commit is contained in:
Marcela Mašláňová 2008-06-24 12:59:59 +00:00
parent 85f75da710
commit c49219d4ad
67 changed files with 25 additions and 25056 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
perl-5.10.0-CVE-2008-2827.patch Normal file
View File

@ -0,0 +1,16 @@
diff -up perl-5.10.0/lib/File/Path.pm.cve perl-5.10.0/lib/File/Path.pm
--- perl-5.10.0/lib/File/Path.pm.cve 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0/lib/File/Path.pm 2008-06-24 13:25:53.000000000 +0200
@@ -351,10 +351,8 @@ sub _rmtree {
}
my $nperm = $perm & 07777 | 0600;
- if ($nperm != $perm and not chmod $nperm, $root) {
- if ($Force_Writeable) {
- _error($arg, "cannot make file writeable", $canon);
- }
+ if ($Force_Writeable && $nperm != $perm and not chmod $nperm, $root) {
+ _error($arg, "cannot make file writeable", $canon);
}
print "unlink $canon\n" if $arg->{verbose};
# delete all versions under VMS

14
perl-5.6.0-buildroot.patch
View File

@ -1,14 +0,0 @@
Without this patch, you see weird things like substitutions that turn
/var/tmp/nstroot/usr/share/man/man1 to /var/tmp/ntsroot/usr/share/man/$(PREFIX),
which is bad.
--- perl-5.6.0/lib/ExtUtils/MM_Unix.pm Sat Jun 17 16:57:55 2000
+++ perl-5.6.0/lib/ExtUtils/MM_Unix.pm Sat Jun 17 16:57:43 2000
@@ -3097,6 +3097,7 @@
sub prefixify {
my($self,$var,$sprefix,$rprefix) = @_;
+ return if (length($sprefix) <= 0);
$self->{uc $var} ||= $Config{lc $var};
$self->{uc $var} = VMS::Filespec::unixpath($self->{uc $var}) if $Is_VMS;
$self->{uc $var} =~ s/\Q$sprefix\E/$rprefix/s;

30
perl-5.7.3-syslog.patch
View File

@ -1,30 +0,0 @@
--- perl-5.7.3/perl.c.syslog Thu May 23 22:26:46 2002
+++ perl-5.7.3/perl.c Thu May 23 22:28:55 2002
@@ -21,6 +21,10 @@
#include <unistd.h>
#endif
+#ifdef I_SYSLOG
+#include <syslog.h>
+#endif
+
#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE) && !defined(PERL_MICRO)
char *getenv (char *); /* Usually in <stdlib.h> */
#endif
@@ -3017,6 +3021,16 @@
if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
tmpstatbuf.st_ino != PL_statbuf.st_ino) {
(void)PerlIO_close(PL_rsfp);
+#ifdef I_SYSLOG
+ openlog("suidperl", LOG_CONS | LOG_PID | LOG_NDELAY, LOG_AUTHPRIV);
+ syslog(LOG_ALERT, "User %ld tried to run dev %ld ino %ld in "
+ "place of dev %ld ino %ld!", PL_uid,
+ (long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
+ (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino);
+ syslog(LOG_ALERT, "Filename of setuid script was %s, uid %"
+ Uid_t_f" gid %"Gid_t_f".", CopFILE(PL_curcop),
+ PL_statbuf.st_uid, PL_statbuf.st_gid);
+#endif
Perl_croak(aTHX_ "Permission denied\n");
}
if (

40
perl-5.8.0-links.patch
View File

@ -1,40 +0,0 @@
--- perl-5.8.0/lib/CPAN/FirstTime.pm.links 2002-08-15 14:58:47.000000000 -0400
+++ perl-5.8.0/lib/CPAN/FirstTime.pm 2002-08-15 14:59:07.000000000 -0400
@@ -258,7 +258,7 @@
my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
local $^W = $old_warn;
my $progname;
- for $progname (qw/gzip tar unzip make lynx wget ncftpget ncftp ftp gpg/){
+ for $progname (qw/gzip tar unzip make links wget ncftpget ncftp ftp gpg/){
if ($^O eq 'MacOS') {
$CPAN::Config->{$progname} = 'not_here';
next;
--- perl-5.8.0/lib/CPAN.pm.links 2002-08-15 14:58:37.000000000 -0400
+++ perl-5.8.0/lib/CPAN.pm 2002-08-15 15:00:08.000000000 -0400
@@ -2528,7 +2528,7 @@
$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
my($f,$funkyftp);
- for $f ('lynx','ncftpget','ncftp','wget') {
+ for $f ('links','ncftpget','ncftp','wget') {
next unless exists $CPAN::Config->{$f};
$funkyftp = $CPAN::Config->{$f};
next unless defined $funkyftp;
@@ -2537,7 +2537,7 @@
($asl_ungz = $aslocal) =~ s/\.gz//;
$asl_gz = "$asl_ungz.gz";
my($src_switch) = "";
- if ($f eq "lynx"){
+ if ($f eq "links"){
$src_switch = " -source";
} elsif ($f eq "ncftp"){
$src_switch = " -c";
@@ -2561,7 +2561,7 @@
my($wstatus);
if (($wstatus = system($system)) == 0
&&
- ($f eq "lynx" ?
+ ($f eq "links" ?
-s $asl_ungz # lynx returns 0 when it fails somewhere
: 1
)

52
perl-5.8.0-nondbm.patch
View File

@ -1,52 +0,0 @@
--- perl-5.7.3/Configure.ndbm Mon May 27 13:27:19 2002
+++ perl-5.7.3/Configure Mon May 27 13:28:15 2002
@@ -1204,7 +1204,7 @@
: List of libraries we want.
: If anyone needs -lnet, put it in a hint file.
-libswanted='sfio socket bind inet nsl nm ndbm gdbm dbm db malloc dl'
+libswanted='sfio socket bind inet nsl nm gdbm dbm db malloc dl'
libswanted="$libswanted dld ld sun m c cposix posix"
libswanted="$libswanted ndir dir crypt sec"
libswanted="$libswanted ucb bsd BSD PW x util"
@@ -18695,40 +18695,6 @@
set mntent.h i_mntent
eval $inhdr
-: see if ndbm.h is available
-set ndbm.h t_ndbm
-eval $inhdr
-
-case "$t_ndbm" in
-$undef)
- # Some Linux distributions such as RedHat 7.1 put the
- # ndbm.h header in /usr/include/gdbm/ndbm.h.
- if $test -f /usr/include/gdbm/ndbm.h; then
- echo '<gdbm/ndbm.h> found.'
- ccflags="$ccflags -I/usr/include/gdbm"
- cppflags="$cppflags -I/usr/include/gdbm"
- t_ndbm=$define
- fi
- ;;
-esac
-
-case "$t_ndbm" in
-$define)
- : see if dbm_open exists
- set dbm_open d_dbm_open
- eval $inlibc
- case "$d_dbm_open" in
- $undef)
- t_ndbm="$undef"
- echo "We won't be including <ndbm.h>"
- ;;
- esac
- ;;
-esac
-val="$t_ndbm"
-set i_ndbm
-eval $setvar
-
: see if net/errno.h is available
val=''
set net/errno.h val

15
perl-5.8.0-nptlhint.patch
View File

@ -1,15 +0,0 @@
Remove the THREADS_HAVE_PIDS hint for NTPL-enabled Linux
systems. Otherwise ppids are cached too aggressively,
resulting in broken behavior.
--- perl-5.8.0/hints/linux.sh.nptl 2004-12-01 12:38:16.021664783 -0500
+++ perl-5.8.0/hints/linux.sh 2004-12-01 12:38:28.213470553 -0500
@@ -249,7 +249,7 @@
cat > UU/usethreads.cbu <<'EOCBU'
case "$usethreads" in
$define|true|[yY]*)
- ccflags="-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS $ccflags"
+ ccflags="-D_REENTRANT -D_GNU_SOURCE $ccflags"
set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
shift
libswanted="$*"

35
perl-5.8.0-rmtree.patch
View File

@ -1,35 +0,0 @@
Fix for CAN-2004-0452. Change chmod's to make files writable/executable
by the current user only and not by the entire world. chmod's necessary
in the first place but at least this makes them less dangerous. If, for
some reason the rm process dies halfway through, at worst some files and
dirs were revoked from others, not made available.
--- perl-5.8.0/lib/File/Path.pm.chmod 2004-11-23 10:41:57.594065752 -0500
+++ perl-5.8.0/lib/File/Path.pm 2004-11-23 10:43:41.453380351 -0500
@@ -184,7 +184,7 @@
# it's also intended to change it to writable in case we have
# to recurse in which case we are better than rm -rf for
# subtrees with strange permissions
- chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+ chmod(0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
or carp "Can't make directory $root read+writeable: $!"
unless $safe;
@@ -218,7 +218,7 @@
print "skipped $root\n" if $verbose;
next;
}
- chmod 0777, $root
+ chmod 0700, $root
or carp "Can't make directory $root writeable: $!"
if $force_writeable;
print "rmdir $root\n" if $verbose;
@@ -240,7 +240,7 @@
print "skipped $root\n" if $verbose;
next;
}
- chmod 0666, $root
+ chmod 0600, $root
or carp "Can't make file $root writeable: $!"
if $force_writeable;
print "unlink $root\n" if $verbose;

12
perl-5.8.0-rpath-make.patch
View File

@ -1,12 +0,0 @@
--- perl-5.8.0/Makefile.SH.makerpath 2002-12-31 10:15:21.000000000 -0500
+++ perl-5.8.0/Makefile.SH 2002-12-31 10:34:13.000000000 -0500
@@ -110,6 +110,9 @@
case "$osname" in
os390) test -f /bin/env && ldlibpth="/bin/env $ldlibpth"
;;
+linux*)
+ ldlibpth="LD_PRELOAD=`pwd`/libperl.so $ldlibpth"
+ ;;
esac
: Prepare dependency lists for Makefile.

12
perl-5.8.0-sharedlinker.patch
View File

@ -1,12 +0,0 @@
--- perl-5.8.0/Makefile.SH.sharedlinker Tue Jun 18 12:36:27 2002
+++ perl-5.8.0/Makefile.SH Tue Jun 18 12:37:31 2002
@@ -61,6 +61,9 @@
netbsd*|freebsd[234]*|openbsd*)
linklibperl="-L. -lperl"
;;
+ linux*)
+ shrpldflags="$shrpldflags $ldflags $perllibs $cryptlib"
+ ;;
aix*)
shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp"
case "$osvers" in

11
perl-5.8.1-fpic.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.1-RC4/Configure.fpic 2003-08-02 00:47:58.000000000 -0400
+++ perl-5.8.1-RC4/Configure 2003-08-02 00:50:08.000000000 -0400
@@ -7501,7 +7501,7 @@
;;
*) case "$osname" in
darwin) dflt='none' ;;
- svr4*|esix*|solaris|nonstopux) dflt='-fPIC' ;;
+ linux*|svr4*|esix*|solaris|nonstopux) dflt='-fPIC' ;;
*) dflt='-fpic' ;;
esac ;;
esac ;;

11
perl-5.8.1-lpthread-link.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.1-RC4/ext/threads/Makefile.PL.lpthread Wed Aug 6 20:09:07 2003
+++ perl-5.8.1-RC4/ext/threads/Makefile.PL Wed Aug 6 20:09:22 2003
@@ -10,7 +10,7 @@
(ABSTRACT_FROM => 'threads.pm', # retrieve abstract from module
AUTHOR => 'Artur Bergman <artur@contiller.se>') : ()),
'MAN3PODS' => {}, # Pods will be built by installman
- 'LIBS' => [''], # e.g., '-lm'
+ 'LIBS' => ['-lpthread'], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
# Insert -I. if you add *.h files later:
# 'INC' => '', # e.g., '-I/usr/include/other'

12
perl-5.8.3-empty-rpath.patch
View File

@ -1,12 +0,0 @@
--- perl-5.8.3/lib/ExtUtils/MM_Unix.pm.orig 2004-03-05 15:04:56.000000000 +0000
+++ perl-5.8.3/lib/ExtUtils/MM_Unix.pm 2004-03-05 15:05:20.000000000 +0000
@@ -1135,7 +1135,7 @@
}
push(@m,
-' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
+' $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) $(INST_DYNAMIC_FIX)');
push @m, '
$(CHMOD) $(PERM_RWX) $@

40
perl-5.8.3-fullinc.patch
View File

@ -1,40 +0,0 @@
--- perl-5.8.3/perl.c.fullinc 2004-02-15 10:39:38.947636711 -0500
+++ perl-5.8.3/perl.c 2004-02-15 10:40:27.399370941 -0500
@@ -4163,23 +4163,17 @@
libdir,
(int)PERL_REVISION, (int)PERL_VERSION,
(int)PERL_SUBVERSION, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
/* .../version if -d .../version */
Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH, libdir,
(int)PERL_REVISION, (int)PERL_VERSION,
(int)PERL_SUBVERSION);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
/* .../archname if -d .../archname */
Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, ARCHNAME);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
}
#ifdef PERL_INC_VERSION_LIST
@@ -4187,9 +4181,7 @@
for (incver = incverlist; *incver; incver++) {
/* .../xxx if -d .../xxx */
Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, libdir, *incver);
- if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
- S_ISDIR(tmpstatbuf.st_mode))
- av_push(GvAVn(PL_incgv), newSVsv(subdir));
+ av_push(GvAVn(PL_incgv), newSVsv(subdir));
}
}
#endif

52
perl-5.8.3-perlbug-tag.patch
View File

@ -1,52 +0,0 @@
--- perl-5.8.0/utils/perlbug.PL.perlbug 2004-10-05 12:07:54.423998839 -0400
+++ perl-5.8.0/utils/perlbug.PL 2004-10-05 12:08:37.607393368 -0400
@@ -27,8 +27,6 @@
open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
or die "Can't open patchlevel.h: $!";
-my $patchlevel_date = (stat PATCH_LEVEL)[9];
-
while (<PATCH_LEVEL>) {
last if $_ =~ /^\s*static\s+char.*?local_patches\[\]\s*=\s*{\s*$/;
}
@@ -64,9 +62,8 @@
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
-my \$config_tag1 = '$extract_version - $Config{cf_time}';
+my \$config_tag1 = '$extract_version';
-my \$patchlevel_date = $patchlevel_date;
my \$patch_tags = '$patch_tags';
my \@patches = (
$patch_desc
@@ -275,17 +272,6 @@
$ok = 0;
if ($::opt_o) {
if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
- my $age = time - $patchlevel_date;
- if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
- my $date = localtime $patchlevel_date;
- print <<"EOF";
-"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
-are more than 60 days old. This Perl version was constructed on
-$date. If you really want to report this, use
-"perlbug -okay" or "perlbug -nokay".
-EOF
- exit();
- }
# force these options
unless ($::opt_n) {
$::opt_S = 1; # don't prompt for send
@@ -592,9 +578,8 @@
print OUT <<EFF;
---
EFF
- print OUT "This perlbug was built using Perl $config_tag1\n",
- "It is being executed now by Perl $config_tag2.\n\n"
- if $config_tag2 ne $config_tag1;
+ print OUT "This perlbug was built using Perl $config_tag1 in the Red Hat build system.\n",
+ "It is being executed now by Perl $config_tag2.\n\n";
print OUT <<EOF;
Site configuration information for perl $perl_version:

22
perl-5.8.5-CAN-2005-0155+0156.patch
View File

@ -1,22 +0,0 @@
Index: perlio.c
===================================================================
--- perlio.c (revision 4342)
+++ perlio.c (revision 4346)
@@ -454,7 +454,7 @@
va_list ap;
dSYS;
va_start(ap, fmt);
- if (!dbg) {
+ if (!dbg && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
char *s = PerlEnv_getenv("PERLIO_DEBUG");
if (s && *s)
dbg = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
@@ -471,7 +471,7 @@
s = CopFILE(PL_curcop);
if (!s)
s = "(none)";
- sprintf(buffer, "%s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
+ sprintf(buffer, "%.40s:%" IVdf " ", s, (IV) CopLINE(PL_curcop));
len = strlen(buffer);
vsprintf(buffer+len, fmt, ap);
PerlLIO_write(dbg, buffer, strlen(buffer));

11
perl-5.8.5-dashI.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.5/perl.c.dashI 2004-10-01 12:40:40.323519280 -0400
+++ perl-5.8.5/perl.c 2004-10-01 12:40:46.159626512 -0400
@@ -1421,7 +1421,7 @@
char *p;
STRLEN len = strlen(s);
p = savepvn(s, len);
- incpush(p, TRUE, TRUE, FALSE);
+ incpush(p, FALSE, FALSE, FALSE);
sv_catpvn(sv, "-I", 2);
sv_catpvn(sv, p, len);
sv_catpvn(sv, " ", 1);

46
perl-5.8.5-incorder.patch
View File

@ -1,46 +0,0 @@
--- perl-5.8.5/perl.c.incorder 2005-03-08 16:11:32.722330404 -0500
+++ perl-5.8.5/perl.c 2005-03-08 16:12:04.738580672 -0500
@@ -4287,9 +4287,6 @@
incpush(APPLLIB_EXP, TRUE, TRUE, TRUE);
#endif
-#ifdef ARCHLIB_EXP
- incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE);
-#endif
#ifdef MACOS_TRADITIONAL
{
Stat_t tmpstatbuf;
@@ -4311,14 +4308,6 @@
if (!PL_tainting)
incpush(":", FALSE, FALSE, TRUE);
#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);
-#else
- incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE);
-#endif
#ifdef SITEARCH_EXP
/* sitearch is always relative to sitelib on Windows for
@@ -4367,6 +4356,18 @@
incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE);
#endif
+#ifdef ARCHLIB_EXP
+ incpush(ARCHLIB_EXP, FALSE, FALSE, 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);
+#else
+ incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE);
+#endif
+
if (!PL_tainting)
incpush(".", FALSE, FALSE, TRUE);
#endif /* MACOS_TRADITIONAL */

142
perl-5.8.6-CGI-3.1.0.patch
View File

@ -1,142 +0,0 @@
https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=158036
diff -ruN perl-5.8.6-cgi308/lib/CGI/t/form.t perl-5.8.6-cgi310/lib/CGI/t/form.t
--- perl-5.8.6-cgi308/lib/CGI/t/form.t 2005-05-15 01:20:29.910116896 +0100
+++ perl-5.8.6-cgi310/lib/CGI/t/form.t 2005-05-05 21:14:56.000000000 +0100
@@ -33,43 +33,43 @@
"start_form()");
is(submit(),
- qq(<input type="submit" tabindex="0" name=".submit" />),
+ qq(<input type="submit" tabindex="1" name=".submit" />),
"submit()");
is(submit(-name => 'foo',
-value => 'bar'),
- qq(<input type="submit" tabindex="1" name="foo" value="bar" />),
+ qq(<input type="submit" tabindex="2" name="foo" value="bar" />),
"submit(-name,-value)");
is(submit({-name => 'foo',
-value => 'bar'}),
- qq(<input type="submit" tabindex="2" name="foo" value="bar" />),
+ qq(<input type="submit" tabindex="3" name="foo" value="bar" />),
"submit({-name,-value})");
is(textfield(-name => 'weather'),
- qq(<input type="text" name="weather" tabindex="3" value="dull" />),
+ qq(<input type="text" name="weather" tabindex="4" value="dull" />),
"textfield({-name})");
is(textfield(-name => 'weather',
-value => 'nice'),
- qq(<input type="text" name="weather" tabindex="4" value="dull" />),
+ qq(<input type="text" name="weather" tabindex="5" value="dull" />),
"textfield({-name,-value})");
is(textfield(-name => 'weather',
-value => 'nice',
-override => 1),
- qq(<input type="text" name="weather" tabindex="5" value="nice" />),
+ qq(<input type="text" name="weather" tabindex="6" value="nice" />),
"textfield({-name,-value,-override})");
is(checkbox(-name => 'weather',
-value => 'nice'),
- qq(<label><input type="checkbox" name="weather" value="nice" tabindex="6" />weather</label>),
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="7" />weather</label>),
"checkbox()");
is(checkbox(-name => 'weather',
-value => 'nice',
-label => 'forecast'),
- qq(<label><input type="checkbox" name="weather" value="nice" tabindex="7" />forecast</label>),
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="8" />forecast</label>),
"checkbox()");
is(checkbox(-name => 'weather',
@@ -77,41 +77,41 @@
-label => 'forecast',
-checked => 1,
-override => 1),
- qq(<label><input type="checkbox" name="weather" value="nice" tabindex="8" checked="checked" />forecast</label>),
+ qq(<label><input type="checkbox" name="weather" value="nice" tabindex="9" checked="checked" />forecast</label>),
"checkbox()");
is(checkbox(-name => 'weather',
-value => 'dull',
-label => 'forecast'),
- qq(<label><input type="checkbox" name="weather" value="dull" tabindex="9" checked="checked" />forecast</label>),
+ qq(<label><input type="checkbox" name="weather" value="dull" tabindex="10" checked="checked" />forecast</label>),
"checkbox()");
is(radio_group(-name => 'game'),
- qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="10" />chess</label> <label><input type="radio" name="game" value="checkers" tabindex="11" />checkers</label>),
+ qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="11" />chess</label> <label><input type="radio" name="game" value="checkers" tabindex="12" />checkers</label>),
'radio_group()');
is(radio_group(-name => 'game',
-labels => {'chess' => 'ping pong'}),
- qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="12" />ping pong</label> <label><input type="radio" name="game" value="checkers" tabindex="13" />checkers</label>),
+ qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="13" />ping pong</label> <label><input type="radio" name="game" value="checkers" tabindex="14" />checkers</label>),
'radio_group()');
is(checkbox_group(-name => 'game',
-Values => [qw/checkers chess cribbage/]),
- qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="14" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="15" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="16" />cribbage</label>),
+ qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="15" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="16" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="17" />cribbage</label>),
'checkbox_group()');
is(checkbox_group(-name => 'game',
'-values' => [qw/checkers chess cribbage/],
'-defaults' => ['cribbage'],
-override=>1),
- qq(<label><input type="checkbox" name="game" value="checkers" tabindex="17" />checkers</label> <label><input type="checkbox" name="game" value="chess" tabindex="18" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" tabindex="19" />cribbage</label>),
+ qq(<label><input type="checkbox" name="game" value="checkers" tabindex="18" />checkers</label> <label><input type="checkbox" name="game" value="chess" tabindex="19" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" tabindex="20" />cribbage</label>),
'checkbox_group()');
is(popup_menu(-name => 'game',
'-values' => [qw/checkers chess cribbage/],
-default => 'cribbage',
-override => 1),
- '<select name="game" tabindex="20">
+ '<select name="game" tabindex="21">
<option value="checkers">checkers</option>
<option value="chess">chess</option>
<option selected="selected" value="cribbage">cribbage</option>
diff -ruN perl-5.8.6-cgi308/lib/CGI.pm perl-5.8.6-cgi310/lib/CGI.pm
--- perl-5.8.6-cgi308/lib/CGI.pm 2005-05-15 01:20:29.955110056 +0100
+++ perl-5.8.6-cgi310/lib/CGI.pm 2005-05-13 22:46:21.000000000 +0100
@@ -18,8 +18,8 @@
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.179 2005/04/07 22:40:37 lstein Exp $';
-$CGI::VERSION=3.08;
+$CGI::revision = '$Id: CGI.pm,v 1.181 2005/05/13 21:45:26 lstein Exp $';
+$CGI::VERSION='3.10';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -179,11 +179,12 @@
if (exists $ENV{MOD_PERL}) {
# mod_perl handlers may run system() on scripts using CGI.pm;
# Make sure so we don't get fooled by inherited $ENV{MOD_PERL}
- if ($ENV{MOD_PERL_API_VERSION} == 2) {
+ if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
$MOD_PERL = 2;
require Apache2::Response;
require Apache2::RequestRec;
require Apache2::RequestUtil;
+ require Apache2::RequestIO;
require APR::Pool;
} else {
$MOD_PERL = 1;
@@ -888,6 +889,7 @@
sub element_tab {
my ($self,$new_value) = self_or_default(@_);
+ $self->{'.etab'} ||= 1;
$self->{'.etab'} = $new_value if defined $new_value;
$self->{'.etab'}++;
}

12
perl-5.8.6-filter-simple-update.patch
View File

@ -1,12 +0,0 @@
diff -ruN Filter-Simple-0.78/lib/Filter/Simple.pm Filter-Simple-0.79/lib/Filter/Simple.pm
--- Filter-Simple-0.78/lib/Filter/Simple.pm 2002-05-17 00:38:58.000000000 +0100
+++ Filter-Simple-0.79/lib/Filter/Simple.pm 2003-09-20 21:02:17.000000000 +0100
@@ -4,7 +4,7 @@
use vars qw{ $VERSION @EXPORT };
-$VERSION = '0.78';
+$VERSION = '0.79';
use Filter::Util::Call;
use Carp;

17
perl-5.8.6-findbin-selinux.patch
View File

@ -1,17 +0,0 @@
diff -ruN perl-5.8.6-orig/lib/FindBin.pm perl-5.8.6/lib/FindBin.pm
--- perl-5.8.6-orig/lib/FindBin.pm 2003-12-27 14:52:04.000000000 +0000
+++ perl-5.8.6/lib/FindBin.pm 2005-05-16 04:15:54.000000000 +0100
@@ -179,7 +179,12 @@
}
# Get absolute paths to directories
- $Bin = abs_path($Bin) if($Bin);
+ if ($Bin)
+ {
+ my $BinOld = $Bin;
+ $Bin = abs_path($Bin);
+ defined $Bin or $Bin = File::Spec->canonpath($BinOld);
+ }
$RealBin = abs_path($RealBin) if($RealBin);
}
}

115
perl-5.8.7-172396.patch
View File

@ -1,115 +0,0 @@
--- perl-5.8.8/config_h.SH.bz172396 2005-10-31 13:13:05.000000000 -0500
+++ perl-5.8.8/config_h.SH 2006-05-11 16:20:36.000000000 -0400
@@ -1912,7 +1912,18 @@
*/
#$d_localtime_r HAS_LOCALTIME_R /**/
#define LOCALTIME_R_PROTO $localtime_r_proto /**/
-
+/* LOCALTIME_R_NEEDS_TZSET :
+ * many libc's localtime_r implementations do not call tzset,
+ * making them differ from localtime(), and making timezone
+ * changes using $ENV{TZ} without explicitly calling tzset
+ * impossible. This symbol makes us call tzset before localtime_r:
+ */
+#$d_localtime_r_needs_tzset LOCALTIME_R_NEEDS_TZSET /**/
+#ifdef LOCALTIME_R_NEEDS_TZSET
+#define L_R_TZSET tzset(),
+#else
+#define L_R_TZSET
+#endif
/* HAS_LONG_DOUBLE:
* This symbol will be defined if the C compiler supports long
* doubles.
--- perl-5.8.8/reentr.inc.bz172396 2006-05-11 16:20:36.000000000 -0400
+++ perl-5.8.8/reentr.inc 2006-05-11 16:20:36.000000000 -0400
@@ -1368,10 +1368,10 @@
#ifdef HAS_LOCALTIME_R
# undef localtime
# if !defined(localtime) && LOCALTIME_R_PROTO == REENTRANT_PROTO_S_TS
-# define localtime(a) (localtime_r(a, &PL_reentrant_buffer->_localtime_struct) ? &PL_reentrant_buffer->_localtime_struct : 0)
+# define localtime(a) ( L_R_TZSET localtime_r(a, &PL_reentrant_buffer->_localtime_struct) ? &PL_reentrant_buffer->_localtime_struct : 0)
# endif
# if !defined(localtime) && LOCALTIME_R_PROTO == REENTRANT_PROTO_I_TS
-# define localtime(a) (localtime_r(a, &PL_reentrant_buffer->_localtime_struct) == 0 ? &PL_reentrant_buffer->_localtime_struct : 0)
+# define localtime(a) ( L_R_TZSET localtime_r(a, &PL_reentrant_buffer->_localtime_struct) == 0 ? &PL_reentrant_buffer->_localtime_struct : 0)
# endif
#endif /* HAS_LOCALTIME_R */
--- perl-5.8.8/Configure.bz172396 2006-05-11 16:20:36.000000000 -0400
+++ perl-5.8.8/Configure 2006-05-11 16:21:47.000000000 -0400
@@ -542,6 +542,7 @@
d_libm_lib_version=''
d_link=''
d_localtime_r=''
+d_localtime_r_needs_tzset=''
localtime_r_proto=''
d_locconv=''
d_lockf=''
@@ -14261,7 +14262,59 @@
*) localtime_r_proto=0
;;
esac
+: see if localtime_r calls tzset
+case "$localtime_r_proto" in
+REENTRANT_PROTO*)
+ $cat >try.c <<EOCP
+/* Does our libc's localtime_r call tzset ?
+ * return 0 if so, 1 otherwise.
+ */
+#include <sys/types.h>
+#include <unistd.h>
+#include <time.h>
+#include <string.h>
+#include <malloc.h>
+int main()
+{
+ time_t t = time(0L);
+ char w_tz[]="TZ=GMT+5",
+ e_tz[]="TZ=GMT-5",
+ *tz_e = (char*)malloc(16),
+ *tz_w = (char*)malloc(16);
+ struct tm tm_e, tm_w;
+ memset(&tm_e,'\0',sizeof(struct tm));
+ memset(&tm_w,'\0',sizeof(struct tm));
+ strcpy(tz_e,e_tz);
+ strcpy(tz_w,w_tz);
+ putenv(tz_e);
+ localtime_r(&t, &tm_e);
+
+ putenv(tz_w);
+ localtime_r(&t, &tm_w);
+
+ if( memcmp(&tm_e, &tm_w, sizeof(struct tm)) == 0 )
+ return 1;
+ return 0;
+}
+EOCP
+ set try
+ if eval $compile; then
+ if ./try; then
+ d_localtime_r_needs_tzset=undef;
+ else
+ d_localtime_r_needs_tzset=define;
+ fi;
+ rm -f ./try;
+ else
+ d_localtime_r_needs_tzset=undef;
+ fi;
+ rm -f try.c;
+ ;;
+ *)
+ d_localtime_r_needs_tzset=undef;
+ ;;
+esac
: see if localeconv exists
set localeconv d_locconv
eval $inlibc
@@ -21220,6 +21273,7 @@
d_libm_lib_version='$d_libm_lib_version'
d_link='$d_link'
d_localtime_r='$d_localtime_r'
+d_localtime_r_needs_tzset='$d_localtime_r_needs_tzset'
d_locconv='$d_locconv'
d_lockf='$d_lockf'
d_longdbl='$d_longdbl'

1269
perl-5.8.7-25084.patch
View File

File diff suppressed because it is too large Load Diff

184
perl-5.8.7-CAN-2004-0976.patch
View File

@ -1,184 +0,0 @@
--- perl-5.8.7/utils/c2ph.PL.CAN-2004-0976 2004-10-19 15:45:42.000000000 -0400
+++ perl-5.8.7/utils/c2ph.PL 2005-11-08 12:53:30.000000000 -0500
@@ -1320,7 +1320,7 @@
$intrinsics{$_[1]} = $template{$_[0]};
}
close(PIPE) || die "couldn't read intrinsics!";
- unlink($TMP, '$SAFEDIR/a.out');
+ unlink($TMP, "$SAFEDIR/a.out");
print STDERR "done\n" if $trace;
}
--- perl-5.8.7/lib/Memoize/t/tie_storable.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
+++ perl-5.8.7/lib/Memoize/t/tie_storable.t 2005-11-08 13:06:13.000000000 -0500
@@ -33,14 +33,7 @@
print "1..4\n";
-
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
- *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-$file = catfile($tmpdir, "storable$$");
+$file = "storable$$";
1 while unlink $file;
tryout('Memoize::Storable', $file, 1); # Test 1..4
1 while unlink $file;
--- perl-5.8.7/lib/Memoize/t/tie_ndbm.t.CAN-2004-0976 2005-04-22 07:36:58.000000000 -0400
+++ perl-5.8.7/lib/Memoize/t/tie_ndbm.t 2005-11-08 13:04:45.000000000 -0500
@@ -28,14 +28,7 @@
print "1..4\n";
-
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
- *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
tryout('Memoize::NDBM_File', $file, 1); # Test 1..4
1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
--- perl-5.8.7/lib/Memoize/t/tie.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
+++ perl-5.8.7/lib/Memoize/t/tie.t 2005-11-08 13:03:20.000000000 -0500
@@ -29,14 +29,7 @@
$_[0]+1;
}
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import('tmpdir', 'catfile');
- $tmpdir = tmpdir();
-} else {
- *catfile = sub { join '/', @_ };
- $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-}
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
@files = ($file, "$file.db", "$file.dir", "$file.pag");
1 while unlink @files;
--- perl-5.8.7/lib/Memoize/t/tie_sdbm.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
+++ perl-5.8.7/lib/Memoize/t/tie_sdbm.t 2005-11-08 13:05:32.000000000 -0500
@@ -28,14 +28,7 @@
print "1..4\n";
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import('tmpdir', 'catfile');
- $tmpdir = tmpdir();
-} else {
- *catfile = sub { join '/', @_ };
- $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-}
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
1 while unlink $file, "$file.dir", "$file.pag";
tryout('Memoize::SDBM_File', $file, 1); # Test 1..4
1 while unlink $file, "$file.dir", "$file.pag";
--- perl-5.8.7/lib/Memoize/t/tie_gdbm.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
+++ perl-5.8.7/lib/Memoize/t/tie_gdbm.t 2005-11-08 13:04:03.000000000 -0500
@@ -26,13 +26,7 @@
print "1..4\n";
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
- *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
1 while unlink $file, "$file.dir", "$file.pag";
tryout('GDBM_File', $file, 1); # Test 1..4
1 while unlink $file, "$file.dir", "$file.pag";
--- perl-5.8.7/lib/ExtUtils/instmodsh.CAN-2004-0976 2004-01-05 17:34:59.000000000 -0500
+++ perl-5.8.7/lib/ExtUtils/instmodsh 2005-11-08 12:42:25.000000000 -0500
@@ -2,6 +2,7 @@
use strict;
use IO::File;
+use File::Temp;
use ExtUtils::Packlist;
use ExtUtils::Installed;
@@ -58,15 +59,14 @@
$reply =~ /^t\s*/ and do
{
my $file = (split(' ', $reply))[1];
- my $tmp = "/tmp/inst.$$";
- if (my $fh = IO::File->new($tmp, "w"))
- {
- $fh->print(join("\n", $Inst->files($module)));
- $fh->close();
- system("tar cvf $file -I $tmp");
- unlink($tmp);
- last CASE;
- }
+ my ($fh, $tmp) = File::Temp::tempfile(UNLINK => 1);
+ $fh->print(join("\n", $Inst->files($module)));
+ $fh->close();
+ # This used to use -I which is wrong for GNU tar.
+ system("tar cvf $file -T $tmp");
+ unlink($tmp);
+ last CASE;
+ }
else { print("Can't open $file: $!\n"); }
last CASE;
};
--- perl-5.8.7/lib/ExtUtils/MakeMaker.pm.CAN-2004-0976 2004-01-05 17:34:59.000000000 -0500
+++ perl-5.8.7/lib/ExtUtils/MakeMaker.pm 2005-11-08 13:07:36.000000000 -0500
@@ -1013,7 +1013,7 @@
The Makefile to be produced may be altered by adding arguments of the
form C<KEY=VALUE>. E.g.
- perl Makefile.PL PREFIX=/tmp/myperl5
+ perl Makefile.PL PREFIX=~/myperl5
Other interesting targets in the generated Makefile are
@@ -1355,13 +1355,13 @@
This is the root directory into which the code will be installed. It
I<prepends itself to the normal prefix>. For example, if your code
-would normally go into /usr/local/lib/perl you could set DESTDIR=/tmp/
-and installation would go into /tmp/usr/local/lib/perl.
+would normally go into /usr/local/lib/perl you could set DESTDIR=~/myperl/
+and installation would go into ~/myperl/usr/local/lib/perl.
This is primarily of use for people who repackage Perl modules.
NOTE: Due to the nature of make, it is important that you put the trailing
-slash on your DESTDIR. "/tmp/" not "/tmp".
+slash on your DESTDIR. "~/myperl/" not "~/myperl".
=item DIR
--- perl-5.8.7/lib/CGI/Cookie.pm.CAN-2004-0976 2005-05-16 04:41:03.000000000 -0400
+++ perl-5.8.7/lib/CGI/Cookie.pm 2005-11-08 14:56:15.141710000 -0500
@@ -407,7 +407,7 @@
You may also retrieve cookies that were stored in some external
form using the parse() class method:
- $COOKIES = `cat /usr/tmp/Cookie_stash`;
+ $COOKIES = `cat /var/run/www/Cookie_stash`;
%cookies = parse CGI::Cookie($COOKIES);
If you are in a mod_perl environment, you can save some overhead by
--- perl-5.8.7/lib/Shell.pm.CAN-2004-0976 2004-06-01 05:42:17.000000000 -0400
+++ perl-5.8.7/lib/Shell.pm 2005-11-08 15:01:36.434664000 -0500
@@ -127,7 +127,7 @@
use Shell qw(cat ps cp);
$passwd = cat('</etc/passwd');
@pslines = ps('-ww'),
- cp("/etc/passwd", "/tmp/passwd");
+ cp("/etc/passwd", "/etc/passwd.orig");
# object oriented
my $sh = Shell->new;

474
perl-5.8.7-CVE-2005-3962-bz174684.patch
View File

@ -1,474 +0,0 @@
--- perl-5.8.7/t/lib/warnings/sv.CVE-2005-3962-bz174684 2004-03-18 07:51:14.000000000 -0500
+++ perl-5.8.7/t/lib/warnings/sv 2005-12-14 12:40:55.000000000 -0500
@@ -301,12 +301,12 @@
printf F "%\x02" ;
$a = sprintf "%\x02" ;
EXPECT
-Invalid conversion in sprintf: "%z" at - line 5.
-Invalid conversion in sprintf: end of string at - line 7.
-Invalid conversion in sprintf: "%\002" at - line 9.
Invalid conversion in printf: "%z" at - line 4.
+Invalid conversion in sprintf: "%z" at - line 5.
Invalid conversion in printf: end of string at - line 6.
+Invalid conversion in sprintf: end of string at - line 7.
Invalid conversion in printf: "%\002" at - line 8.
+Invalid conversion in sprintf: "%\002" at - line 9.
########
# sv.c
use warnings 'misc' ;
--- perl-5.8.7/t/op/sprintf.t.CVE-2005-3962-bz174684 2003-09-01 03:41:07.000000000 -0400
+++ perl-5.8.7/t/op/sprintf.t 2005-12-14 12:53:09.000000000 -0500
@@ -385,3 +385,8 @@
>%4$K %d< >[45, 67]< >%4$K 45 INVALID<
>%d %K %d< >[23, 45]< >23 %K 45 INVALID<
>%*v*999\$d %d %d< >[11, 22, 33]< >%*v*999\$d 11 22 INVALID<
+>%#b< >0< >0<
+>%#o< >0< >0<
+>%#x< >0< >0<
+>%2918905856$v2d< >''< ><
+>%*2918905856$v2d< >''< > UNINIT<
--- perl-5.8.7/t/op/sprintf2.t.CVE-2005-3962-bz174684 2004-02-09 16:37:13.000000000 -0500
+++ perl-5.8.7/t/op/sprintf2.t 2005-12-14 12:50:39.000000000 -0500
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 3;
+plan tests => 7 + 256;
is(
sprintf("%.40g ",0.01),
@@ -26,3 +26,43 @@
q(width calculation under utf8 upgrade)
);
}
+
+# Used to mangle PL_sv_undef
+fresh_perl_is(
+ 'print sprintf "xxx%n\n"; print undef',
+ 'Modification of a read-only value attempted at - line 1.',
+ { switches => [ '-w' ] },
+ q(%n should not be able to modify read-only constants),
+);
+
+# check %NNN$ for range bounds, especially negative 2's complement
+{
+ my ($warn, $bad) = (0,0);
+ local $SIG{__WARN__} = sub {
+ if ($_[0] =~ /uninitialized/) {
+ $warn++
+ }
+ else {
+ $bad++
+ }
+ };
+ my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)),
+ qw(a b c d);
+ is($result, "abcd", "only four valid values");
+ is($warn, 36, "expected warnings");
+ is($bad, 0, "unexpected warnings");
+}
+{
+ foreach my $ord (0 .. 255) {
+ my $bad = 0;
+ local $SIG{__WARN__} = sub {
+ unless ($_[0] =~ /^Invalid conversion in sprintf/ ||
+ $_[0] =~ /^Use of uninitialized value in sprintf/) {
+ warn $_[0];
+ $bad++;
+ }
+ };
+ my $r = eval {sprintf '%v' . chr $ord};
+ is ($bad, 0, "pattern '%v' . chr $ord");
+ }
+}
--- perl-5.8.7/opcode.h.CVE-2005-3962-bz174684 2005-05-27 12:29:50.000000000 -0400
+++ perl-5.8.7/opcode.h 2005-12-14 12:40:55.000000000 -0500
@@ -1585,7 +1585,7 @@
0x0022281c, /* vec */
0x0122291c, /* index */
0x0122291c, /* rindex */
- 0x0004280f, /* sprintf */
+ 0x0004280d, /* sprintf - WAS 0x0004280f before patch #26283 */
0x00042805, /* formline */
0x0001379e, /* ord */
0x0001378e, /* chr */
--- perl-5.8.7/op.c.CVE-2005-3962-bz174684 2005-04-22 10:12:32.000000000 -0400
+++ perl-5.8.7/op.c 2005-12-14 12:40:55.000000000 -0500
@@ -2076,7 +2076,9 @@
/* XXX might want a ck_negate() for this */
cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
break;
- case OP_SPRINTF:
+/* Removed as part of fix for CVE-2005-3962 / Upstream patch 26283 :
+ * case OP_SPRINTF:
+ */
case OP_UCFIRST:
case OP_LCFIRST:
case OP_UC:
--- perl-5.8.7/makedef.pl.CVE-2005-3962-bz174684 2005-05-09 09:27:41.000000000 -0400
+++ perl-5.8.7/makedef.pl 2005-12-14 12:40:55.000000000 -0500
@@ -635,11 +635,13 @@
)];
}
-if ($define{'PERL_MALLOC_WRAP'}) {
- emit_symbols [qw(
- PL_memory_wrap
- )];
-}
+# Removed as part of fix for CVE-2005-3962 / CVE-2005-3962 /
+# Upstream patch #26283
+# if ($define{'PERL_MALLOC_WRAP'}) {
+# emit_symbols [qw(
+# PL_memory_wrap
+# )];
+#}
unless ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) {
skip_symbols [qw(
--- perl-5.8.7/ext/Sys/Syslog/Syslog.pm.CVE-2005-3962-bz174684 2005-04-22 07:53:56.000000000 -0400
+++ perl-5.8.7/ext/Sys/Syslog/Syslog.pm 2005-12-14 12:40:55.000000000 -0500
@@ -1,14 +1,13 @@
package Sys::Syslog;
require 5.006;
require Exporter;
-require DynaLoader;
use Carp;
use strict;
-our @ISA = qw(Exporter DynaLoader);
+our @ISA = qw(Exporter);
our @EXPORT = qw(openlog closelog setlogmask syslog);
our @EXPORT_OK = qw(setlogsock);
-our $VERSION = '0.06';
+our $VERSION = '0.08';
# it would be nice to try stream/unix first, since that will be
# most efficient. However streams are dodgy - see _syslog_send_stream
@@ -54,26 +53,38 @@
=item openlog $ident, $logopt, $facility
+Opens the syslog.
I<$ident> is prepended to every message. I<$logopt> contains zero or
more of the words I<pid>, I<ndelay>, I<nowait>. The cons option is
ignored, since the failover mechanism will drop down to the console
automatically if all other media fail. I<$facility> specifies the
part of the system to report about, for example LOG_USER or LOG_LOCAL0:
see your C<syslog(3)> documentation for the facilities available in
-your system.
+your system. This function will croak if it can't connect to the syslog
+daemon.
B<You should use openlog() before calling syslog().>
+=item syslog $priority, $message
+
=item syslog $priority, $format, @args
-If I<$priority> permits, logs I<($format, @args)>
-printed as by C<printf(3V)>, with the addition that I<%m>
-is replaced with C<"$!"> (the latest error message).
+If I<$priority> permits, logs I<$message> or I<sprintf($format, @args)>
+with the addition that I<%m> in $message or $format is replaced with
+C<"$!"> (the latest error message).
If you didn't use openlog() before using syslog(), syslog will try to
guess the I<$ident> by extracting the shortest prefix of I<$format>
that ends in a ":".
+Note that Sys::Syslog version v0.07 and older passed the $message as
+the formatting string to sprintf() even when no formatting arguments
+were provided. If the code calling syslog() might execute with older
+versions of this module, make sure to call the function as
+syslog($priority, "%s", $message) instead of syslog($priority,
+$message). This protects against hostile formatting sequences that
+might show up if $message contains tainted data.
+
=item setlogmask $mask_priority
Sets log mask I<$mask_priority> and returns the old mask.
@@ -175,7 +186,8 @@
goto &$AUTOLOAD;
}
-bootstrap Sys::Syslog $VERSION;
+require XSLoader;
+XSLoader::load('Sys::Syslog', $VERSION);
our $maskpri = &LOG_UPTO(&LOG_DEBUG);
@@ -316,9 +328,16 @@
$whoami .= "[$$]" if our $lo_pid;
- $mask =~ s/(?<!%)%m/$!/g;
+ if ($mask =~ /%m/) {
+ my $err = $!;
+ # escape percent signs if sprintf will be called
+ $err =~ s/%/%%/g if @_;
+ # replace %m with $err, if preceded by an even number of percent signs
+ $mask =~ s/(?<!%)((?:%%)*)%m/$1$err/g;
+ }
+
$mask .= "\n" unless $mask =~ /\n$/;
- $message = sprintf ($mask, @_);
+ $message = @_ ? sprintf($mask, @_) : $mask;
$sum = $numpri + $numfac;
my $buf = "<$sum>$whoami: $message\0";
--- perl-5.8.7/opcode.pl.CVE-2005-3962-bz174684 2004-12-01 08:54:30.000000000 -0500
+++ perl-5.8.7/opcode.pl 2005-12-14 12:40:55.000000000 -0500
@@ -606,7 +606,7 @@
index index ck_index isT@ S S S?
rindex rindex ck_index isT@ S S S?
-sprintf sprintf ck_fun mfst@ S L
+sprintf sprintf ck_fun mst@ S L
formline formline ck_fun ms@ S L
ord ord ck_fun ifsTu% S?
chr chr ck_fun fsTu% S?
--- perl-5.8.7/handy.h.CVE-2005-3962-bz174684 2005-04-20 12:33:28.000000000 -0400
+++ perl-5.8.7/handy.h 2005-12-14 12:40:55.000000000 -0500
@@ -598,91 +598,65 @@
=cut */
-#ifndef lint
-
#define NEWSV(x,len) newSV(len)
#ifdef PERL_MALLOC_WRAP
#define MEM_WRAP_CHECK(n,t) \
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(PL_memory_wrap),0):0)
#define MEM_WRAP_CHECK_1(n,t,a) \
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a),0):0)
#define MEM_WRAP_CHECK_2(n,t,a,b) \
- (void)((n)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
+ (void)((sizeof(t)>1?(n):1)>((MEM_SIZE)~0)/sizeof(t)?(Perl_croak_nocontext(a,b),0):0)
+#define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t),
-#define New(x,v,n,t) (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
-#define Newc(x,v,n,t,c) (v = (MEM_WRAP_CHECK(n,t), (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
-#define Newz(x,v,n,t) (v = (MEM_WRAP_CHECK(n,t), (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))), \
- memzero((char*)(v), (n)*sizeof(t))
-#define Renew(v,n,t) \
- (v = (MEM_WRAP_CHECK(n,t), (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
-#define Renewc(v,n,t,c) \
- (v = (MEM_WRAP_CHECK(n,t), (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
-#define Safefree(d) safefree((Malloc_t)(d))
-
-#define Move(s,d,n,t) (MEM_WRAP_CHECK(n,t), (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t)))
-#define Copy(s,d,n,t) (MEM_WRAP_CHECK(n,t), (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t)))
-#define Zero(d,n,t) (MEM_WRAP_CHECK(n,t), (void)memzero((char*)(d), (n) * sizeof(t)))
-
-#define MoveD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memmove((char*)(d),(char*)(s), (n) * sizeof(t)))
-#define CopyD(s,d,n,t) (MEM_WRAP_CHECK(n,t), memcpy((char*)(d),(char*)(s), (n) * sizeof(t)))
-#ifdef HAS_MEMSET
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK(n,t), memzero((char*)(d), (n) * sizeof(t)))
-#else
-/* Using bzero(), which returns void. */
-#define ZeroD(d,n,t) (MEM_WRAP_CHECK(n,t), memzero((char*)(d), (n) * sizeof(t)),d)
-#endif
-
-#define Poison(d,n,t) (MEM_WRAP_CHECK(n,t), (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
+#define PERL_STRLEN_ROUNDUP(n) ((void)(((n) > (MEM_SIZE)~0 - 2 * PERL_STRLEN_ROUNDUP_QUANTUM) ? (Perl_croak_nocontext(PL_memory_wrap),0):0),((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
#else
#define MEM_WRAP_CHECK(n,t)
#define MEM_WRAP_CHECK_1(n,t,a)
#define MEM_WRAP_CHECK_2(n,t,a,b)
+#define MEM_WRAP_CHECK_(n,t)
+
+#define PERL_STRLEN_ROUNDUP(n) (((n-1+PERL_STRLEN_ROUNDUP_QUANTUM)&~((MEM_SIZE)PERL_STRLEN_ROUNDUP_QUANTUM-1)))
-#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
-#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n)*sizeof(t))))
-#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))), \
+#endif
+
+#define Newx(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
+#define Newxc(v,n,t,c) (v = (MEM_WRAP_CHECK_(n,t) (c*)safemalloc((MEM_SIZE)((n)*sizeof(t)))))
+#define Newxz(v,n,t) (v = (MEM_WRAP_CHECK_(n,t) (t*)safemalloc((MEM_SIZE)((n)*sizeof(t))))), \
memzero((char*)(v), (n)*sizeof(t))
+/* pre 5.9.x compatibility */
+#define New(x,v,n,t) Newx(v,n,t)
+#define Newc(x,v,n,t,c) Newxc(v,n,t,c)
+#define Newz(x,v,n,t) Newxz(v,n,t)
+
#define Renew(v,n,t) \
- (v = (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
+ (v = (MEM_WRAP_CHECK_(n,t) (t*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
#define Renewc(v,n,t,c) \
- (v = (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#define Safefree(d) safefree((Malloc_t)(d))
-
-#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
-#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
-#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
+ (v = (MEM_WRAP_CHECK_(n,t) (c*)saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))
-#define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
-#define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
-#ifdef HAS_MEMSET
-#define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
+#ifdef PERL_POISON
+#define Safefree(d) \
+ (d ? (void)(safefree((Malloc_t)(d)), Poison(&(d), 1, Malloc_t)) : (void) 0)
#else
-#define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
+#define Safefree(d) safefree((Malloc_t)(d))
#endif
-#define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
+#define Move(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Copy(s,d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define Zero(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memzero((char*)(d), (n) * sizeof(t)))
+#define MoveD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memmove((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#define CopyD(s,d,n,t) (MEM_WRAP_CHECK_(n,t) memcpy((char*)(d),(const char*)(s), (n) * sizeof(t)))
+#ifdef HAS_MEMSET
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)))
+#else
+/* Using bzero(), which returns void. */
+#define ZeroD(d,n,t) (MEM_WRAP_CHECK_(n,t) memzero((char*)(d), (n) * sizeof(t)),d)
#endif
-#else /* lint */
-
-#define New(x,v,n,s) (v = Null(s *))
-#define Newc(x,v,n,s,c) (v = Null(s *))
-#define Newz(x,v,n,s) (v = Null(s *))
-#define Renew(v,n,s) (v = Null(s *))
-#define Move(s,d,n,t)
-#define Copy(s,d,n,t)
-#define Zero(d,n,t)
-#define MoveD(s,d,n,t) d
-#define CopyD(s,d,n,t) d
-#define ZeroD(d,n,t) d
-#define Poison(d,n,t)
-#define Safefree(d) (d) = (d)
-
-#endif /* lint */
+#define Poison(d,n,t) (MEM_WRAP_CHECK_(n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t)))
#ifdef USE_STRUCT_COPY
#define StructCopy(s,d,t) (*((t*)(d)) = *((t*)(s)))
--- perl-5.8.7/perl.h.CVE-2005-3962-bz174684 2005-12-14 12:40:55.000000000 -0500
+++ perl-5.8.7/perl.h 2005-12-14 12:40:55.000000000 -0500
@@ -720,6 +720,13 @@
#define MEM_SIZE Size_t
+/* Round all values passed to malloc up, by default to a multiple of
+ sizeof(size_t)
+*/
+#ifndef PERL_STRLEN_ROUNDUP_QUANTUM
+#define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size
+#endif
+
#if defined(STANDARD_C) && defined(I_STDDEF)
# include <stddef.h>
# define STRUCT_OFFSET(s,m) offsetof(s,m)
@@ -3332,10 +3339,8 @@
INIT("\"my\" variable %s can't be in a package");
EXTCONST char PL_no_localize_ref[]
INIT("Can't localize through a reference");
-#ifdef PERL_MALLOC_WRAP
EXTCONST char PL_memory_wrap[]
INIT("panic: memory wrap");
-#endif
EXTCONST char PL_uuemap[65]
INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
--- perl-5.8.7/sv.c.CVE-2005-3962-bz174684 2005-05-27 06:38:11.000000000 -0400
+++ perl-5.8.7/sv.c 2005-12-14 12:48:45.000000000 -0500
@@ -8589,9 +8589,12 @@
if (vectorarg) {
if (args)
vecsv = va_arg(*args, SV*);
- else
- vecsv = (evix ? evix <= svmax : svix < svmax) ?
- svargs[evix ? evix-1 : svix++] : &PL_sv_undef;
+ else if (evix) {
+ vecsv = (evix > 0 && evix <= svmax)
+ ? svargs[evix-1] : &PL_sv_undef;
+ } else {
+ vecsv = svix < svmax ? svargs[svix++] : &PL_sv_undef;
+ }
dotstr = SvPVx(vecsv, dotstrlen);
if (DO_UTF8(vecsv))
is_utf8 = TRUE;
@@ -8601,12 +8604,13 @@
vecstr = (U8*)SvPVx(vecsv,veclen);
vec_utf8 = DO_UTF8(vecsv);
}
- else if (efix ? efix <= svmax : svix < svmax) {
+ else if (efix ? (efix > 0 && efix <= svmax) : svix < svmax) {
vecsv = svargs[efix ? efix-1 : svix++];
vecstr = (U8*)SvPVx(vecsv,veclen);
vec_utf8 = DO_UTF8(vecsv);
}
else {
+ vecsv = &PL_sv_undef;
vecstr = (U8*)"";
veclen = 0;
}
@@ -8707,9 +8711,15 @@
if (vectorize)
argsv = vecsv;
- else if (!args)
- argsv = (efix ? efix <= svmax : svix < svmax) ?
- svargs[efix ? efix-1 : svix++] : &PL_sv_undef;
+ else if (!args) {
+ if (efix) {
+ const I32 i = efix-1;
+ argsv = (i >= 0 && i < svmax) ? svargs[i] : &PL_sv_undef;
+ } else {
+ argsv = (svix >= 0 && svix < svmax)
+ ? svargs[svix++] : &PL_sv_undef;
+ }
+ }
switch (c = *q++) {
@@ -8972,6 +8982,8 @@
*--eptr = '0';
break;
case 2:
+ if (!uv)
+ alt = FALSE;
do {
dig = uv & 1;
*--eptr = '0' + dig;
@@ -9274,6 +9286,8 @@
/* calculate width before utf8_upgrade changes it */
have = esignlen + zeros + elen;
+ if (have < zeros)
+ Perl_croak_nocontext(PL_memory_wrap);
if (is_utf8 != has_utf8) {
if (is_utf8) {
@@ -9301,6 +9315,9 @@
need = (have > width ? have : width);
gap = need - have;
+ if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
+ Perl_croak_nocontext(PL_memory_wrap);
+
SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
p = SvEND(sv);
if (esignlen && fill == '0') {
--- perl-5.8.7/globvar.sym.CVE-2005-3962-bz174684 2000-08-14 11:22:14.000000000 -0400
+++ perl-5.8.7/globvar.sym 2005-12-14 12:51:12.000000000 -0500
@@ -66,3 +66,4 @@
vtbl_collxfrm
vtbl_amagic
vtbl_amagicelem
+memory_wrap

23
perl-5.8.7-IOC_SIZE.patch
View File

@ -1,23 +0,0 @@
--- perl-5.8.7/perl.h.IOC_SIZE 2005-05-07 16:11:45.000000000 -0400
+++ perl-5.8.7/perl.h 2005-10-25 16:56:10.000000000 -0400
@@ -2508,11 +2508,17 @@
#ifndef IOCPARM_LEN
# ifdef IOCPARM_MASK
- /* on BSDish systes we're safe */
+ /* on BSDish systems we're safe */
# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK)
# else
- /* otherwise guess at what's safe */
-# define IOCPARM_LEN(x) 256
+# ifdef _IOC_SIZE
+ /* on Linux systems we're safe */
+# define IOCPARM_LEN(x) _IOC_SIZE(x)
+# else
+ /* otherwise guess at what's safe (we're UNSAFE!) */
+# warning "unsafe assumption of IOCPARM_LEN=256"
+# define IOCPARM_LEN(x) 256
+# endif
# endif
#endif

38
perl-5.8.7-MM_Unix-rpath-136009.patch
View File

@ -1,38 +0,0 @@
--- perl-5.8.7/lib/ExtUtils/MM_Unix.pm.136009 2005-11-08 20:08:30.000000000 -0500
+++ perl-5.8.7/lib/ExtUtils/MM_Unix.pm 2005-11-09 12:54:41.000000000 -0500
@@ -413,11 +413,18 @@
};
my($tmp);
for $tmp (qw/
- EXTRALIBS LDLOADLIBS BSLOADLIBS LD_RUN_PATH
+ EXTRALIBS LDLOADLIBS BSLOADLIBS
/) {
next unless defined $self->{$tmp};
push @m, "$tmp = $self->{$tmp}\n";
}
+ # don't set LD_RUN_PATH if empty
+ for $tmp (qw/
+ LD_RUN_PATH
+ /) {
+ next unless $self->{$tmp};
+ push @m, "$tmp = $self->{$tmp}\n";
+ }
return join "", @m;
}
@@ -1134,9 +1141,13 @@
}
}
+ my $ld_run_path_shell = "";
+ if ($self->{LD_RUN_PATH} ne "") {
+ $ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
+ }
push(@m,
-' $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
-' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) $(INST_DYNAMIC_FIX)');
+ ' '.$ld_run_path_shell.'$(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
+ ' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) '.$libs.' $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) $(INST_DYNAMIC_FIX)');
push @m, '
$(CHMOD) $(PERM_RWX) $@
';

115
perl-5.8.7-USE_MM_LD_RUN_PATH.patch
View File

@ -1,115 +0,0 @@
--- perl-5.8.7/lib/ExtUtils/MakeMaker.pm.USE_MM_LD_RUN_PATH 2005-12-08 15:10:24.000000000 -0500
+++ perl-5.8.7/lib/ExtUtils/MakeMaker.pm 2005-12-08 19:36:26.000000000 -0500
@@ -226,7 +226,7 @@
PERL_SRC PERM_RW PERM_RWX
PL_FILES PM PM_FILTER PMLIBDIRS POLLUTE PPM_INSTALL_EXEC
PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
- SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
+ SKIP TYPEMAPS USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS XSOPT XSPROTOARG
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
tool_autosplit
@@ -362,7 +362,27 @@
print join(" ", map { "perl($_)>=$self->{PREREQ_PM}->{$_} " }
sort keys %{$self->{PREREQ_PM}}), "\n";
exit 0;
- }
+ }
+
+ # USE_MM_LD_RUN_PATH - another RedHatism to disable automatic RPATH generation
+ if ( ( ! $self->{USE_MM_LD_RUN_PATH} )
+ &&( ("@ARGV" =~ /\bUSE_MM_LD_RUN_PATH(=([01]))?\b/)
+ ||( exists( $ENV{USE_MM_LD_RUN_PATH} )
+ &&( $ENV{USE_MM_LD_RUN_PATH} =~ /([01])?$/ )
+ )
+ )
+ )
+ {
+ my $v = $1;
+ if( $v )
+ {
+ $v = ($v=~/=([01])$/)[0];
+ }else
+ {
+ $v = 1;
+ };
+ $self->{USE_MM_LD_RUN_PATH}=$v;
+ }
print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose;
if (-f "MANIFEST" && ! -f "Makefile"){
@@ -2007,6 +2027,40 @@
precedence, even if it isn't listed in TYPEMAPS. The default system
typemap has lowest precedence.
+=item USE_MM_LD_RUN_PATH
+
+boolean
+The Red Hat perl MakeMaker distribution differs from the standard
+upstream release in that it disables use of the MakeMaker generated
+LD_RUN_PATH by default, UNLESS this attribute is specified , or the
+USE_MM_LD_RUN_PATH environment variable is set during the MakeMaker run.
+
+The upstream MakeMaker will set the ld(1) environment variable LD_RUN_PATH
+to the concatenation of every -L ld(1) option directory in which a -l ld(1)
+option library is found, which is used as the ld(1) -rpath option if none
+is specified. This means that, if your application builds shared libraries
+and your MakeMaker application links to them, that the absolute paths of the
+libraries in the build tree will be inserted into the RPATH header of all
+MakeMaker generated binaries, and that such binaries will be unable to link
+to these libraries if they do not still reside in the build tree directories
+(unlikely) or in the system library directories (/lib or /usr/lib), regardless
+of any LD_LIBRARY_PATH setting. So if you specified -L../mylib -lmylib , and
+ your 'libmylib.so' gets installed into /some_directory_other_than_usr_lib,
+ your MakeMaker application will be unable to link to it, even if LD_LIBRARY_PATH
+is set to include /some_directory_other_than_usr_lib, because RPATH overrides
+LD_LIBRARY_PATH.
+
+So for Red Hat MakeMaker builds LD_RUN_PATH is NOT generated by default for
+every link. You can still use explicit -rpath ld options or the LD_RUN_PATH
+environment variable during the build to generate an RPATH for the binaries.
+
+You can set the USE_MM_LD_RUN_PATH attribute to 1 on the MakeMaker command
+line or in the WriteMakefile arguments to enable generation of LD_RUN_PATH
+for every link command.
+
+USE_MM_LD_RUN_PATH will default to 1 (LD_RUN_PATH will be used) IF the
+$USE_MM_LD_RUN_PATH environment variable is set during a MakeMaker run.
+
=item VENDORPREFIX
Like PERLPREFIX, but only for the vendor install locations.
--- perl-5.8.7/lib/ExtUtils/MM_Unix.pm.USE_MM_LD_RUN_PATH 2005-12-08 15:10:24.000000000 -0500
+++ perl-5.8.7/lib/ExtUtils/MM_Unix.pm 2005-12-08 18:35:13.000000000 -0500
@@ -1142,7 +1142,7 @@
}
my $ld_run_path_shell = "";
- if ($self->{LD_RUN_PATH} ne "") {
+ if (($self->{LD_RUN_PATH} ne "") && ($self->{USE_MM_LD_RUN_PATH})) {
$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
}
push(@m,
--- perl-5.8.7/lib/ExtUtils/Liblist.pm.USE_MM_LD_RUN_PATH 2003-04-07 14:58:17.000000000 -0400
+++ perl-5.8.7/lib/ExtUtils/Liblist.pm 2005-12-08 19:39:28.000000000 -0500
@@ -51,6 +51,8 @@
specifics below. The list of the filenames is returned only if
$need_names argument is true.
+NOTE: if the LD_RUN_PATH me
+
Dependent libraries can be linked in one of three ways:
=over 2
@@ -87,6 +89,11 @@
in LDLOADLIBS. It is passed as an environment variable to the process
that links the shared library.
+Red Hat extension: This generation of LD_RUN_PATH is disabled by default.
+To use the generated LD_RUN_PATH for all links, set the USE_MM_LD_RUN_PATH
+MakeMaker object attribute / argument, (or set the $USE_MM_LD_RUN_PATH
+environment variable).
+
=head2 BSLOADLIBS
List of those libraries that are needed but can be linked in

21
perl-5.8.7-bz172236.patch
View File

@ -1,21 +0,0 @@
--- perl-5.8.7/utils/h2ph.PL.bz172236 2005-04-04 17:47:17.000000000 -0400
+++ perl-5.8.7/utils/h2ph.PL 2005-11-01 17:42:36.000000000 -0500
@@ -734,9 +734,15 @@
# non-GCC?) C compilers, but gcc uses an additional include directory.
sub inc_dirs
{
- my $from_gcc = `$Config{cc} -v 2>&1`;
- $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s;
-
+ my $from_gcc = `LC_ALL=C $Config{cc} -v 2>&1`;
+ if( !( $from_gcc =~ s:^Reading specs from (.*?)/specs\b.*:$1/include:s ) )
+ { # gcc-4+ :
+ $from_gcc = `LC_ALL=C $Config{cc} -print-search-dirs 2>&1`;
+ if ( !($from_gcc =~ s/^install:\s*([^\s]+[^\s\/])([\s\/]*).*$/$1\/include/s) )
+ {
+ $from_gcc = '';
+ };
+ };
length($from_gcc) ? ($from_gcc, $Config{usrinc}) : ($Config{usrinc});
}

114
perl-5.8.7-bz172587.patch
View File

@ -1,114 +0,0 @@
--- perl-5.8.7/pp_sort.c.bz172587 2005-04-08 05:31:47.000000000 -0400
+++ perl-5.8.7/pp_sort.c 2005-11-07 12:57:07.000000000 -0500
@@ -1510,6 +1510,7 @@
if (gimme != G_ARRAY) {
SP = MARK;
+ EXTEND(SP,1);
RETPUSHUNDEF;
}
--- perl-5.8.7/pp_hot.c.bz172587 2005-04-22 10:12:27.000000000 -0400
+++ perl-5.8.7/pp_hot.c 2005-11-07 12:55:16.000000000 -0500
@@ -639,12 +639,12 @@
}
}
SP = ORIGMARK;
- PUSHs(&PL_sv_yes);
+ XPUSHs(&PL_sv_yes);
RETURN;
just_say_no:
SP = ORIGMARK;
- PUSHs(&PL_sv_undef);
+ XPUSHs(&PL_sv_undef);
RETURN;
}
--- perl-5.8.7/pp_sys.c.bz172587 2005-04-27 18:12:46.000000000 -0400
+++ perl-5.8.7/pp_sys.c 2005-11-07 13:03:39.000000000 -0500
@@ -429,13 +429,16 @@
SV *tmpsv;
char *tmps;
STRLEN len;
- if (SP - MARK != 1) {
+ if (SP - MARK > 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
tmpsv = TARG;
SP = MARK + 1;
- }
- else {
+ }
+ else if (SP == MARK ) {
+ tmpsv = &PL_sv_no;
+ EXTEND(SP, 1);
+ } else {
tmpsv = TOPs;
}
tmps = SvPV(tmpsv, len);
@@ -3517,7 +3520,7 @@
I32 value = (I32)apply(PL_op->op_type, MARK, SP);
SP = MARK;
- PUSHi(value);
+ XPUSHi(value);
RETURN;
#else
DIE(aTHX_ PL_no_func, "chown");
@@ -4127,7 +4130,7 @@
if (errno != EAGAIN) {
value = -1;
SP = ORIGMARK;
- PUSHi(value);
+ XPUSHi(value);
if (did_pipes) {
PerlLIO_close(pp[0]);
PerlLIO_close(pp[1]);
@@ -4176,7 +4179,7 @@
STATUS_CURRENT = -1;
}
}
- PUSHi(STATUS_CURRENT);
+ XPUSHi(STATUS_CURRENT);
RETURN;
}
if (did_pipes) {
@@ -4222,7 +4225,7 @@
STATUS_NATIVE_SET(value);
do_execfree();
SP = ORIGMARK;
- PUSHi(result ? value : STATUS_CURRENT);
+ XPUSHi(result ? value : STATUS_CURRENT);
#endif /* !FORK or VMS */
RETURN;
}
@@ -4275,7 +4278,7 @@
}
SP = ORIGMARK;
- PUSHi(value);
+ XPUSHi(value);
RETURN;
}
--- perl-5.8.7/pp.c.bz172587 2005-05-16 11:30:13.000000000 -0400
+++ perl-5.8.7/pp.c 2005-11-07 12:56:32.000000000 -0500
@@ -721,7 +721,7 @@
while (MARK < SP)
do_chop(TARG, *++MARK);
SP = ORIGMARK;
- PUSHTARG;
+ XPUSHTARG;
RETURN;
}
@@ -739,7 +739,7 @@
while (SP > MARK)
count += do_chomp(POPs);
- PUSHi(count);
+ XPUSHi(count);
RETURN;
}

11
perl-5.8.7-bz172739_obz36521.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.7/util.c.25160 2005-05-30 08:44:15.000000000 -0400
+++ perl-5.8.7/util.c 2005-11-08 18:58:36.000000000 -0500
@@ -1290,6 +1290,8 @@
SV *msg;
ENTER;
+ SAVESPTR(PL_warnhook);
+ PL_warnhook = Nullsv;
save_re_context();
msg = newSVpvn(message, msglen);
SvFLAGS(msg) |= utf8;

63
perl-5.8.7-incpush.patch
View File

@ -1,63 +0,0 @@
--- perl-5.8.7/perl.c.orig 2005-04-22 17:14:27.000000000 +0300
+++ perl-5.8.7/perl.c 2005-06-17 22:31:31.000000000 +0300
@@ -109,6 +109,7 @@
#endif
static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
+STATIC void incpush_oldversion(pTHX_ char *dir);
#ifdef IAMSUID
#ifndef DOSUID
@@ -4435,6 +4436,7 @@
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
+ incpush_oldversion(aTHX_ SITEARCH_EXP);
# endif
#endif
@@ -4456,6 +4458,7 @@
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
+ incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
# endif
#endif
@@ -4497,6 +4500,36 @@
# define PERLLIB_MANGLE(s,n) (s)
#endif
+#define VERSION_DIRECTORY_STRING "/5.8.7"
+STATIC void
+incpush_oldversion(pTHX_ char *dir)
+{
+#ifdef PERL_INC_VERSION_LIST
+ const char *incverlist[] = { PERL_INC_VERSION_LIST };
+ const char **incver;
+ const char *verdir;
+
+ verdir = strstr(dir, VERSION_DIRECTORY_STRING);
+ if (!verdir)
+ return;
+
+ for (incver = incverlist; *incver; incver++) {
+ char *new_dir = malloc(strlen(dir) + strlen(*incver) + 2);
+ char *p = new_dir;
+
+ strcpy(new_dir, dir);
+ p += verdir - dir + 1; /* advance to char following '/' in VERSION_DIRECTORY_STRING */
+ memcpy(p, *incver, strlen(*incver)); /* copy incver there instead */
+ p += strlen(*incver); /* advance past version we just copied */
+ strcpy(p, verdir + strlen(VERSION_DIRECTORY_STRING)); /* and copy the rest of the original dir */
+
+ incpush(new_dir, FALSE, FALSE, FALSE);
+ free(new_dir);
+ }
+#endif
+}
+
+
/* Push a directory onto @INC if it exists.
Generate a new SV if we do this, to save needing to copy the SV we push
onto @INC */

12
perl-5.8.7-no-debugging.patch
View File

@ -1,12 +0,0 @@
--- perl-5.8.7/Configure.orig 2005-08-28 18:48:03.000000000 -0400
+++ perl-5.8.7/Configure 2005-08-28 18:49:28.000000000 -0400
@@ -4707,9 +4707,6 @@
case "$gccversion" in
1*) dflt='-fpcc-struct-return' ;;
esac
- case "$optimize" in
- *-g*) dflt="$dflt -DDEBUGGING";;
- esac
case "$gccversion" in
2*) if test -d /etc/conf/kconfig.d &&
$contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1

122
perl-5.8.8-CAN-2004-0976.patch
View File

@ -1,122 +0,0 @@
--- perl-5.8.8-RC1/utils/c2ph.PL.CAN-2004-0976 2004-10-19 15:45:42.000000000 -0400
+++ perl-5.8.8-RC1/utils/c2ph.PL 2006-01-20 15:51:09.000000000 -0500
@@ -1320,7 +1320,7 @@
$intrinsics{$_[1]} = $template{$_[0]};
}
close(PIPE) || die "couldn't read intrinsics!";
- unlink($TMP, '$SAFEDIR/a.out');
+ unlink($TMP, "$SAFEDIR/a.out");
print STDERR "done\n" if $trace;
}
--- perl-5.8.8-RC1/lib/CGI/Cookie.pm.CAN-2004-0976 2006-01-08 11:39:14.000000000 -0500
+++ perl-5.8.8-RC1/lib/CGI/Cookie.pm 2006-01-20 15:51:09.000000000 -0500
@@ -407,7 +407,7 @@
You may also retrieve cookies that were stored in some external
form using the parse() class method:
- $COOKIES = `cat /usr/tmp/Cookie_stash`;
+ $COOKIES = `cat /var/run/www/Cookie_stash`;
%cookies = parse CGI::Cookie($COOKIES);
If you are in a mod_perl environment, you can save some overhead by
--- perl-5.8.8-RC1/lib/Memoize/t/tie_storable.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
+++ perl-5.8.8-RC1/lib/Memoize/t/tie_storable.t 2006-01-20 15:51:09.000000000 -0500
@@ -33,14 +33,7 @@
print "1..4\n";
-
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
- *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-$file = catfile($tmpdir, "storable$$");
+$file = "storable$$";
1 while unlink $file;
tryout('Memoize::Storable', $file, 1); # Test 1..4
1 while unlink $file;
--- perl-5.8.8-RC1/lib/Memoize/t/tie_ndbm.t.CAN-2004-0976 2005-04-22 07:36:58.000000000 -0400
+++ perl-5.8.8-RC1/lib/Memoize/t/tie_ndbm.t 2006-01-20 15:51:09.000000000 -0500
@@ -28,14 +28,7 @@
print "1..4\n";
-
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
- *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
tryout('Memoize::NDBM_File', $file, 1); # Test 1..4
1 while unlink $file, "$file.dir", "$file.pag", "$file.db";
--- perl-5.8.8-RC1/lib/Memoize/t/tie.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
+++ perl-5.8.8-RC1/lib/Memoize/t/tie.t 2006-01-20 15:51:09.000000000 -0500
@@ -29,14 +29,7 @@
$_[0]+1;
}
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import('tmpdir', 'catfile');
- $tmpdir = tmpdir();
-} else {
- *catfile = sub { join '/', @_ };
- $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-}
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
@files = ($file, "$file.db", "$file.dir", "$file.pag");
1 while unlink @files;
--- perl-5.8.8-RC1/lib/Memoize/t/tie_sdbm.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
+++ perl-5.8.8-RC1/lib/Memoize/t/tie_sdbm.t 2006-01-20 15:51:09.000000000 -0500
@@ -28,14 +28,7 @@
print "1..4\n";
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import('tmpdir', 'catfile');
- $tmpdir = tmpdir();
-} else {
- *catfile = sub { join '/', @_ };
- $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-}
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
1 while unlink $file, "$file.dir", "$file.pag";
tryout('Memoize::SDBM_File', $file, 1); # Test 1..4
1 while unlink $file, "$file.dir", "$file.pag";
--- perl-5.8.8-RC1/lib/Memoize/t/tie_gdbm.t.CAN-2004-0976 2002-07-12 15:56:19.000000000 -0400
+++ perl-5.8.8-RC1/lib/Memoize/t/tie_gdbm.t 2006-01-20 15:51:09.000000000 -0500
@@ -26,13 +26,7 @@
print "1..4\n";
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
- *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
1 while unlink $file, "$file.dir", "$file.pag";
tryout('GDBM_File', $file, 1); # Test 1..4
1 while unlink $file, "$file.dir", "$file.pag";
--- perl-5.8.8-RC1/lib/Shell.pm.CAN-2004-0976 2004-06-01 05:42:17.000000000 -0400
+++ perl-5.8.8-RC1/lib/Shell.pm 2006-01-20 15:51:09.000000000 -0500
@@ -127,7 +127,7 @@
use Shell qw(cat ps cp);
$passwd = cat('</etc/passwd');
@pslines = ps('-ww'),
- cp("/etc/passwd", "/tmp/passwd");
+ cp("/etc/passwd", "/etc/passwd.orig");
# object oriented
my $sh = Shell->new;

110
perl-5.8.8-DB_File-1.815.patch
View File

@ -1,110 +0,0 @@
diff -up perl-5.8.8/ext/DB_File/Changes.BAD perl-5.8.8/ext/DB_File/Changes
--- perl-5.8.8/ext/DB_File/Changes.BAD 2007-10-01 12:31:56.000000000 -0400
+++ perl-5.8.8/ext/DB_File/Changes 2007-10-01 12:32:19.000000000 -0400
@@ -1,5 +1,12 @@
+1.815 4 February 2007
+
+ * A few casting cleanups for building with C++ from Steve Peters.
+
+ * Fixed problem with recno which happened if you changed directory after
+ opening the database. Problem reported by Andrew Pam.
+
1.814 11 November 2005
* Fix from Dominic Dunlop to tidy up an OS-X specific warning in
diff -up perl-5.8.8/ext/DB_File/DB_File.pm.BAD perl-5.8.8/ext/DB_File/DB_File.pm
--- perl-5.8.8/ext/DB_File/DB_File.pm.BAD 2007-10-01 12:32:36.000000000 -0400
+++ perl-5.8.8/ext/DB_File/DB_File.pm 2007-10-01 12:33:41.000000000 -0400
@@ -1,10 +1,10 @@
# DB_File.pm -- Perl 5 interface to Berkeley DB
#
# written by Paul Marquess (pmqs@cpan.org)
-# last modified 11th November 2005
-# version 1.814
+# last modified 4th February 2007
+# version 1.815
#
-# Copyright (c) 1995-2005 Paul Marquess. All rights reserved.
+# Copyright (c) 1995-2007 Paul Marquess. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
@@ -165,7 +165,7 @@ our ($db_version, $use_XSLoader, $splice
use Carp;
-$VERSION = "1.814" ;
+$VERSION = "1.815" ;
{
local $SIG{__WARN__} = sub {$splice_end_array = "@_";};
@@ -260,6 +260,10 @@ sub tie_hash_or_array
my (@arg) = @_ ;
my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ;
+ use File::Spec;
+ $arg[1] = File::Spec->rel2abs($arg[1])
+ if defined $arg[1] ;
+
$arg[4] = tied %{ $arg[4] }
if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
diff -up perl-5.8.8/ext/DB_File/DB_File.xs.BAD perl-5.8.8/ext/DB_File/DB_File.xs
--- perl-5.8.8/ext/DB_File/DB_File.xs.BAD 2007-10-01 12:33:52.000000000 -0400
+++ perl-5.8.8/ext/DB_File/DB_File.xs 2007-10-01 12:35:50.000000000 -0400
@@ -3,8 +3,8 @@
DB_File.xs -- Perl 5 interface to Berkeley DB
written by Paul Marquess <pmqs@cpan.org>
- last modified 11th November 2005
- version 1.814
+ last modified 4th February 2007
+ version 1.815
All comments/suggestions/problems are welcome
@@ -114,6 +114,7 @@
1.812 - no change
1.813 - no change
1.814 - no change
+ 1.814 - C++ casting fixes
*/
@@ -410,12 +411,12 @@ typedef struct {
typedef DB_File_type * DB_File ;
typedef DBT DBTKEY ;
-#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
+#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s)
#define OutputValue(arg, name) \
{ if (RETVAL == 0) { \
SvGETMAGIC(arg) ; \
- my_sv_setpvn(arg, name.data, name.size) ; \
+ my_sv_setpvn(arg, (const char *)name.data, name.size) ; \
TAINT; \
SvTAINTED_on(arg); \
SvUTF8_off(arg); \
@@ -428,7 +429,7 @@ typedef DBT DBTKEY ;
{ \
SvGETMAGIC(arg) ; \
if (db->type != DB_RECNO) { \
- my_sv_setpvn(arg, name.data, name.size); \
+ my_sv_setpvn(arg, (const char *)name.data, name.size); \
} \
else \
sv_setiv(arg, (I32)*(I32*)name.data - 1); \
@@ -597,8 +598,8 @@ const DBT * key2 ;
PUSHMARK(SP) ;
EXTEND(SP,2) ;
- PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
- PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
+ PUSHs(sv_2mortal(newSVpvn((const char*)data1,key1->size)));
+ PUSHs(sv_2mortal(newSVpvn((const char*)data2,key2->size)));
PUTBACK ;
count = perl_call_sv(CurrentDB->compare, G_SCALAR);

135
perl-5.8.8-R-switch.patch
View File

@ -1,135 +0,0 @@
--- perl-5.8.8/pod/perlrun.pod.-R-switch 2006-01-13 11:29:17.000000000 -0500
+++ perl-5.8.8/pod/perlrun.pod 2006-06-02 00:29:17.000000000 -0400
@@ -11,6 +11,7 @@
S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ] [ B<-f> ]>
S<[ B<-C [I<number/list>] >]>
S<[ B<-P> ]>
+ S<[ B<-R> ]>
S<[ B<-S> ]>
S<[ B<-x>[I<dir>] ]>
S<[ B<-i>[I<extension>] ]>
@@ -813,6 +814,26 @@
before being searched for on the PATH. On Unix platforms, the
program will be searched for strictly on the PATH.
+=item B<-R>
+X<-R>
+
+Disables the Red Hat module compatibility default search path.
+
+By default, the Red Hat perl distribution will prepend to the default
+search path (@INC) the -V:archname subdirectory of each member of
+the -V:inc_version_list under the perl vendor and site installation
+directories.
+i.e. in shell notation:
+ {-V:vendorlib_stem,-V:sitelib_stem}/{-V:inc_version_list}/-V:archname
+where inc_version_list includes every previous perl version shipped
+by Red Hat, to provide compatibility for binary modules installed under
+previous perl versions. This can be quite a long list of directories
+to search, which can slow down module loading. You can disable searching
+these previous perl version architecture specific directories by specifying
+the -R switch - then the default search path will be as for the default
+upstream perl release.
+
+
=item B<-t>
X<-t>
--- perl-5.8.8/proto.h.-R-switch 2006-06-01 19:13:32.000000000 -0400
+++ perl-5.8.8/proto.h 2006-06-01 23:15:04.000000000 -0400
@@ -1620,7 +1620,7 @@
STATIC void S_init_ids(pTHX);
STATIC void S_init_lexer(pTHX);
STATIC void S_init_main_stash(pTHX);
-STATIC void S_init_perllib(pTHX);
+STATIC void S_init_perllib(pTHX,bool rhi);
STATIC void S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env);
STATIC void S_init_predump_symbols(pTHX);
STATIC void S_my_exit_jump(pTHX)
--- perl-5.8.8/embed.fnc.-R-switch 2006-06-01 19:13:32.000000000 -0400
+++ perl-5.8.8/embed.fnc 2006-06-01 23:21:25.000000000 -0400
@@ -1080,7 +1080,7 @@
s |void |init_ids
s |void |init_lexer
s |void |init_main_stash
-s |void |init_perllib
+s |void |init_perllib |bool redhat_incpush
s |void |init_postdump_symbols|int argc|NN char **argv|NULLOK char **env
s |void |init_predump_symbols
rs |void |my_exit_jump
--- perl-5.8.8/embed.h.-R-switch 2006-06-01 19:13:32.000000000 -0400
+++ perl-5.8.8/embed.h 2006-06-01 23:13:11.000000000 -0400
@@ -3170,7 +3170,7 @@
#define init_ids() S_init_ids(aTHX)
#define init_lexer() S_init_lexer(aTHX)
#define init_main_stash() S_init_main_stash(aTHX)
-#define init_perllib() S_init_perllib(aTHX)
+#define init_perllib(rhi) S_init_perllib(aTHX,rhi)
#define init_postdump_symbols(a,b,c) S_init_postdump_symbols(aTHX_ a,b,c)
#define init_predump_symbols() S_init_predump_symbols(aTHX)
#define my_exit_jump() S_my_exit_jump(aTHX)
--- perl-5.8.8/perl.c.-R-switch 2006-06-01 23:08:08.000000000 -0400
+++ perl-5.8.8/perl.c 2006-06-02 00:00:23.000000000 -0400
@@ -1649,6 +1649,7 @@
#ifdef USE_SITECUSTOMIZE
bool minus_f = FALSE;
#endif
+ bool redhat_incpush = TRUE;
PL_fdscript = -1;
PL_suidscript = -1;
@@ -1770,11 +1771,15 @@
PL_preprocess = TRUE;
s++;
goto reswitch;
+ case 'R':
+ redhat_incpush = FALSE;
+ s++;
+ goto reswitch;
case 'S':
forbid_setid("-S");
dosearch = TRUE;
s++;
- goto reswitch;
+ goto reswitch;
case 'V':
{
SV *opts_prog;
@@ -2062,7 +2067,7 @@
scriptname = "-";
}
- init_perllib();
+ init_perllib(redhat_incpush);
open_script(scriptname,dosearch,sv);
@@ -4736,7 +4741,7 @@
}
STATIC void
-S_init_perllib(pTHX)
+S_init_perllib(pTHX, bool redhat_incpush)
{
char *s;
if (!PL_tainting) {
@@ -4803,7 +4808,8 @@
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
- incpush_oldversion(aTHX_ SITEARCH_EXP);
+ if ( redhat_incpush )
+ incpush_oldversion(aTHX_ SITEARCH_EXP);
# endif
#endif
@@ -4825,7 +4831,8 @@
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
- incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
+ if ( redhat_incpush )
+ incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
# endif
#endif

44
perl-5.8.8-U27116.patch
View File

@ -1,44 +0,0 @@
--- perl-5.8.8/t/op/index.t.U27116 2005-10-31 09:11:17.000000000 -0500
+++ perl-5.8.8/t/op/index.t 2006-06-01 18:20:53.000000000 -0400
@@ -7,7 +7,7 @@
use strict;
require './test.pl';
-plan( tests => 58 );
+plan( tests => 66 );
my $foo = 'Now is the time for all good men to come to the aid of their country.';
@@ -121,3 +121,15 @@
is (index($text, $search_octets), -1);
is (rindex($text, $search_octets), -1);
}
+
+foreach my $utf8 ('', ', utf-8') {
+ foreach my $arraybase (0, 1, -1, -2) {
+ my $expect_pos = 2 + $arraybase;
+
+ my $prog = "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; ";
+ $prog .= '$big .= chr 256; chop $big; ' if $utf8;
+ $prog .= 'print rindex $big, "N", 2 + $[';
+
+ fresh_perl_is($prog, $expect_pos, {}, "\$[ = $arraybase$utf8");
+ }
+}
--- perl-5.8.8/pp.c.U27116 2006-06-01 17:04:25.000000000 -0400
+++ perl-5.8.8/pp.c 2006-06-01 18:19:16.000000000 -0400
@@ -3258,9 +3258,13 @@
if (MAXARG < 3)
offset = blen;
else {
+ /* arybase is in characters, like offset, so combine prior to the
+ UTF-8 to bytes calculation. */
+ offset -= arybase;
if (offset > 0 && big_utf8)
sv_pos_u2b(big, &offset, 0);
- offset = offset - arybase + llen;
+ /* llen is in bytes. */
+ offset += llen;
}
if (offset < 0)
offset = 0;

112
perl-5.8.8-U27329.patch
View File

@ -1,112 +0,0 @@
--- perl-5.8.8/t/op/lc.t.U27329 2005-11-07 09:22:36.000000000 -0500
+++ perl-5.8.8/t/op/lc.t 2006-06-01 22:02:13.000000000 -0400
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 59;
+plan tests => 77;
$a = "HELLO.* world";
$b = "hello.* WORLD";
@@ -163,3 +163,38 @@
is($a, v10, "[perl #18857]");
}
}
+
+
+# [perl #38619] Bug in lc and uc (interaction between UTF-8, substr, and lc/uc)
+
+for ("a\x{100}", "xyz\x{100}") {
+ is(substr(uc($_), 0), uc($_), "[perl #38619] uc");
+}
+for ("A\x{100}", "XYZ\x{100}") {
+ is(substr(lc($_), 0), lc($_), "[perl #38619] lc");
+}
+for ("a\x{100}", "ßyz\x{100}") { # ß to Ss (different length)
+ is(substr(ucfirst($_), 0), ucfirst($_), "[perl #38619] ucfirst");
+}
+
+# Related to [perl #38619]
+# the original report concerns PERL_MAGIC_utf8.
+# these cases concern PERL_MAGIC_regex_global.
+
+for (map { $_ } "a\x{100}", "abc\x{100}", "\x{100}") {
+ chop; # get ("a", "abc", "") in utf8
+ my $return = uc($_) =~ /\G(.?)/g;
+ my $result = $return ? $1 : "not";
+ my $expect = (uc($_) =~ /(.?)/g)[0];
+ is($return, 1, "[perl #38619]");
+ is($result, $expect, "[perl #38619]");
+}
+
+for (map { $_ } "A\x{100}", "ABC\x{100}", "\x{100}") {
+ chop; # get ("A", "ABC", "") in utf8
+ my $return = lc($_) =~ /\G(.?)/g;
+ my $result = $return ? $1 : "not";
+ my $expect = (lc($_) =~ /(.?)/g)[0];
+ is($return, 1, "[perl #38619]");
+ is($result, $expect, "[perl #38619]");
+}
--- perl-5.8.8/pp.c.U27329 2006-06-01 21:30:14.000000000 -0400
+++ perl-5.8.8/pp.c 2006-06-01 21:53:37.000000000 -0400
@@ -3447,7 +3447,8 @@
if (slen > ulen)
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
SvUTF8_on(TARG);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
s = (U8*)SvPV_force_nomg(sv, slen);
@@ -3502,7 +3503,8 @@
if (slen > ulen)
sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
SvUTF8_on(TARG);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
s = (U8*)SvPV_force_nomg(sv, slen);
@@ -3552,7 +3554,8 @@
if (!len) {
SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
STRLEN min = len + 1;
@@ -3585,7 +3588,8 @@
*d = '\0';
SvUTF8_on(TARG);
SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
}
else {
@@ -3636,7 +3640,8 @@
if (!len) {
SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
else {
STRLEN min = len + 1;
@@ -3688,7 +3693,8 @@
*d = '\0';
SvUTF8_on(TARG);
SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
- SETs(TARG);
+ sv = TARG;
+ SETs(sv);
}
}
else {

495
perl-5.8.8-U27391.patch
View File

@ -1,495 +0,0 @@
--- perl-5.8.8/t/op/bop.t.U27391 2006-01-06 17:44:14.000000000 -0500
+++ perl-5.8.8/t/op/bop.t 2006-06-01 18:43:20.000000000 -0400
@@ -15,7 +15,7 @@
# If you find tests are failing, please try adding names to tests to track
# down where the failure is, and supply your new names as a patch.
# (Just-in-time test naming)
-plan tests => 49;
+plan tests => 148;
# numerics
ok ((0xdead & 0xbeef) == 0x9ead);
@@ -197,3 +197,149 @@
$b &= "b";
ok($b =~ /b+$/, 'Unicode "b" is NUL-terminated');
}
+
+require "./test.pl";
+curr_test(50);
+
+# double magic tests
+
+sub TIESCALAR { bless { value => $_[1], orig => $_[1] } }
+sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] }
+sub FETCH { $_[0]{fetch}++; $_[0]{value} }
+sub stores { tied($_[0])->{value} = tied($_[0])->{orig};
+ delete(tied($_[0])->{store}) || 0 }
+sub fetches { delete(tied($_[0])->{fetch}) || 0 }
+
+# numeric double magic tests
+
+tie $x, "main", 1;
+tie $y, "main", 3;
+
+is(($x | $y), 3);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), 1);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), 2);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), 3);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), 1);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), 2);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~~$y, 3);
+is(fetches($y), 1);
+is(stores($y), 0);
+
+{ use integer;
+
+is(($x | $y), 3);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), 1);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), 2);
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), 3);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), 1);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), 2);
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~$y, -4);
+is(fetches($y), 1);
+is(stores($y), 0);
+
+} # end of use integer;
+
+# stringwise double magic tests
+
+tie $x, "main", "a";
+tie $y, "main", "c";
+
+is(($x | $y), ("a" | "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x & $y), ("a" & "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x ^ $y), ("a" ^ "c"));
+is(fetches($x), 1);
+is(fetches($y), 1);
+is(stores($x), 0);
+is(stores($y), 0);
+
+is(($x |= $y), ("a" | "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x &= $y), ("a" & "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(($x ^= $y), ("a" ^ "c"));
+is(fetches($x), 2);
+is(fetches($y), 1);
+is(stores($x), 1);
+is(stores($y), 0);
+
+is(~~$y, "c");
+is(fetches($y), 1);
+is(stores($y), 0);
--- perl-5.8.8/pp.c.U27391 2006-06-01 18:19:16.000000000 -0400
+++ perl-5.8.8/pp.c 2006-06-01 18:43:19.000000000 -0400
@@ -2229,13 +2229,15 @@
dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
{
dPOPTOPssrl;
+ if (SvGMAGICAL(left)) mg_get(left);
+ if (SvGMAGICAL(right)) mg_get(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = SvIV(left) & SvIV(right);
+ const IV i = SvIV_nomg(left) & SvIV_nomg(right);
SETi(i);
}
else {
- const UV u = SvUV(left) & SvUV(right);
+ const UV u = SvUV_nomg(left) & SvUV_nomg(right);
SETu(u);
}
}
@@ -2252,13 +2254,15 @@
dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
{
dPOPTOPssrl;
+ if (SvGMAGICAL(left)) mg_get(left);
+ if (SvGMAGICAL(right)) mg_get(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
+ const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right);
SETi(i);
}
else {
- const UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
+ const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right);
SETu(u);
}
}
@@ -2275,13 +2279,15 @@
dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
{
dPOPTOPssrl;
+ if (SvGMAGICAL(left)) mg_get(left);
+ if (SvGMAGICAL(right)) mg_get(right);
if (SvNIOKp(left) || SvNIOKp(right)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
+ const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right);
SETi(i);
}
else {
- const UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
+ const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right);
SETu(u);
}
}
@@ -2376,13 +2382,15 @@
dSP; dTARGET; tryAMAGICun(compl);
{
dTOPss;
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
if (SvNIOKp(sv)) {
if (PL_op->op_private & HINT_INTEGER) {
- const IV i = ~SvIV(sv);
+ const IV i = ~SvIV_nomg(sv);
SETi(i);
}
else {
- const UV u = ~SvUV(sv);
+ const UV u = ~SvUV_nomg(sv);
SETu(u);
}
}
@@ -2392,7 +2400,7 @@
STRLEN len;
(void)SvPV_nomg_const(sv,len); /* force check for uninit var */
- SvSetSV(TARG, sv);
+ sv_setsv_nomg(TARG, sv);
tmps = (U8*)SvPV_force(TARG, len);
anum = len;
if (SvUTF8(TARG)) {
--- perl-5.8.8/global.sym.U27391 2006-01-31 10:50:34.000000000 -0500
+++ perl-5.8.8/global.sym 2006-06-01 18:43:19.000000000 -0400
@@ -432,6 +432,7 @@
Perl_sv_2cv
Perl_sv_2io
Perl_sv_2iv
+Perl_sv_2iv_flags
Perl_sv_2mortal
Perl_sv_2nv
Perl_sv_2pv
@@ -439,6 +440,7 @@
Perl_sv_2pvbyte
Perl_sv_pvn_nomg
Perl_sv_2uv
+Perl_sv_2uv_flags
Perl_sv_iv
Perl_sv_uv
Perl_sv_nv
--- perl-5.8.8/proto.h.U27391 2006-01-31 10:50:34.000000000 -0500
+++ perl-5.8.8/proto.h 2006-06-01 18:43:19.000000000 -0400
@@ -1139,14 +1139,16 @@
PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV* sv);
PERL_CALLCONV CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref);
PERL_CALLCONV IO* Perl_sv_2io(pTHX_ SV* sv);
-PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV* sv);
+/* PERL_CALLCONV IV sv_2iv(pTHX_ SV* sv); */
+PERL_CALLCONV IV Perl_sv_2iv_flags(pTHX_ SV* sv, I32 flags);
PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV* sv);
PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV* sv);
/* PERL_CALLCONV char* sv_2pv(pTHX_ SV* sv, STRLEN* lp); */
PERL_CALLCONV char* Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp);
PERL_CALLCONV char* Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp);
PERL_CALLCONV char* Perl_sv_pvn_nomg(pTHX_ SV* sv, STRLEN* lp);
-PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV* sv);
+/* PERL_CALLCONV UV sv_2uv(pTHX_ SV* sv); */
+PERL_CALLCONV UV Perl_sv_2uv_flags(pTHX_ SV* sv, I32 flags);
PERL_CALLCONV IV Perl_sv_iv(pTHX_ SV* sv);
PERL_CALLCONV UV Perl_sv_uv(pTHX_ SV* sv);
PERL_CALLCONV NV Perl_sv_nv(pTHX_ SV* sv);
--- perl-5.8.8/embed.fnc.U27391 2006-01-31 09:40:27.000000000 -0500
+++ perl-5.8.8/embed.fnc 2006-06-01 18:43:19.000000000 -0400
@@ -727,14 +727,16 @@
Apd |bool |sv_2bool |NN SV* sv
Apd |CV* |sv_2cv |NULLOK SV* sv|NN HV** st|NN GV** gvp|I32 lref
Apd |IO* |sv_2io |NN SV* sv
-Apd |IV |sv_2iv |NN SV* sv
+Amb |IV |sv_2iv |NN SV* sv
+Apd |IV |sv_2iv_flags |NN SV* sv|I32 flags
Apd |SV* |sv_2mortal |NULLOK SV* sv
Apd |NV |sv_2nv |NN SV* sv
Amb |char* |sv_2pv |NN SV* sv|NULLOK STRLEN* lp
Apd |char* |sv_2pvutf8 |NN SV* sv|NULLOK STRLEN* lp
Apd |char* |sv_2pvbyte |NN SV* sv|NULLOK STRLEN* lp
Ap |char* |sv_pvn_nomg |NN SV* sv|NULLOK STRLEN* lp
-Apd |UV |sv_2uv |NN SV* sv
+Amb |UV |sv_2uv |NN SV* sv
+Apd |UV |sv_2uv_flags |NN SV* sv|I32 flags
Apd |IV |sv_iv |NN SV* sv
Apd |UV |sv_uv |NN SV* sv
Apd |NV |sv_nv |NN SV* sv
--- perl-5.8.8/embed.h.U27391 2006-01-31 10:50:34.000000000 -0500
+++ perl-5.8.8/embed.h 2006-06-01 18:43:19.000000000 -0400
@@ -780,13 +780,13 @@
#define sv_2bool Perl_sv_2bool
#define sv_2cv Perl_sv_2cv
#define sv_2io Perl_sv_2io
-#define sv_2iv Perl_sv_2iv
+#define sv_2iv_flags Perl_sv_2iv_flags
#define sv_2mortal Perl_sv_2mortal
#define sv_2nv Perl_sv_2nv
#define sv_2pvutf8 Perl_sv_2pvutf8
#define sv_2pvbyte Perl_sv_2pvbyte
#define sv_pvn_nomg Perl_sv_pvn_nomg
-#define sv_2uv Perl_sv_2uv
+#define sv_2uv_flags Perl_sv_2uv_flags
#define sv_iv Perl_sv_iv
#define sv_uv Perl_sv_uv
#define sv_nv Perl_sv_nv
@@ -2831,13 +2831,13 @@
#define sv_2bool(a) Perl_sv_2bool(aTHX_ a)
#define sv_2cv(a,b,c,d) Perl_sv_2cv(aTHX_ a,b,c,d)
#define sv_2io(a) Perl_sv_2io(aTHX_ a)
-#define sv_2iv(a) Perl_sv_2iv(aTHX_ a)
+#define sv_2iv_flags(a,b) Perl_sv_2iv_flags(aTHX_ a,b)
#define sv_2mortal(a) Perl_sv_2mortal(aTHX_ a)
#define sv_2nv(a) Perl_sv_2nv(aTHX_ a)
#define sv_2pvutf8(a,b) Perl_sv_2pvutf8(aTHX_ a,b)
#define sv_2pvbyte(a,b) Perl_sv_2pvbyte(aTHX_ a,b)
#define sv_pvn_nomg(a,b) Perl_sv_pvn_nomg(aTHX_ a,b)
-#define sv_2uv(a) Perl_sv_2uv(aTHX_ a)
+#define sv_2uv_flags(a,b) Perl_sv_2uv_flags(aTHX_ a,b)
#define sv_iv(a) Perl_sv_iv(aTHX_ a)
#define sv_uv(a) Perl_sv_uv(aTHX_ a)
#define sv_nv(a) Perl_sv_nv(aTHX_ a)
--- perl-5.8.8/sv.h.U27391 2006-01-02 09:51:46.000000000 -0500
+++ perl-5.8.8/sv.h 2006-06-01 18:43:20.000000000 -0400
@@ -953,6 +953,9 @@
=for apidoc Am|char*|SvPVx|SV* sv|STRLEN len
A version of C<SvPV> which guarantees to evaluate sv only once.
+=for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len
+Like C<SvPV> but doesn't process magic.
+
=for apidoc Am|char*|SvPV_nolen|SV* sv
Returns a pointer to the string in the SV, or a stringified form of
the SV if the SV does not contain a string. The SV may cache the
@@ -962,6 +965,9 @@
Coerces the given SV to an integer and returns it. See C<SvIVx> for a
version which guarantees to evaluate sv only once.
+=for apidoc Am|IV|SvIV_nomg|SV* sv
+Like C<SvIV> but doesn't process magic.
+
=for apidoc Am|IV|SvIVx|SV* sv
Coerces the given SV to an integer and returns it. Guarantees to evaluate
sv only once. Use the more efficient C<SvIV> otherwise.
@@ -978,6 +984,9 @@
Coerces the given SV to an unsigned integer and returns it. See C<SvUVx>
for a version which guarantees to evaluate sv only once.
+=for apidoc Am|UV|SvUV_nomg|SV* sv
+Like C<SvUV> but doesn't process magic.
+
=for apidoc Am|UV|SvUVx|SV* sv
Coerces the given SV to an unsigned integer and returns it. Guarantees to
evaluate sv only once. Use the more efficient C<SvUV> otherwise.
@@ -1050,6 +1059,9 @@
#define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv))
+#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
+#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
+
/* ----*/
#define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC)
@@ -1251,6 +1263,8 @@
#define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0)
#define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC)
#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC)
+#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC)
+#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC)
/* Should be named SvCatPVN_utf8_upgrade? */
#define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv) \
--- perl-5.8.8/sv.c.U27391 2006-01-16 07:22:21.000000000 -0500
+++ perl-5.8.8/sv.c 2006-06-01 18:43:19.000000000 -0400
@@ -2062,22 +2062,34 @@
}
#endif /* !NV_PRESERVES_UV*/
+/* sv_2iv() is now a macro using Perl_sv_2iv_flags();
+ * this function provided for binary compatibility only
+ */
+
+IV
+Perl_sv_2iv(pTHX_ register SV *sv)
+{
+ return sv_2iv_flags(sv, SV_GMAGIC);
+}
+
/*
-=for apidoc sv_2iv
+=for apidoc sv_2iv_flags
-Return the integer value of an SV, doing any necessary string conversion,
-magic etc. Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
+Return the integer value of an SV, doing any necessary string
+conversion. If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
=cut
*/
IV
-Perl_sv_2iv(pTHX_ register SV *sv)
+Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
{
if (!sv)
return 0;
if (SvGMAGICAL(sv)) {
- mg_get(sv);
+ if (flags & SV_GMAGIC)
+ mg_get(sv);
if (SvIOKp(sv))
return SvIVX(sv);
if (SvNOKp(sv)) {
@@ -2361,23 +2373,34 @@
return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
}
+/* sv_2uv() is now a macro using Perl_sv_2uv_flags();
+ * this function provided for binary compatibility only
+ */
+
+UV
+Perl_sv_2uv(pTHX_ register SV *sv)
+{
+ return sv_2uv_flags(sv, SV_GMAGIC);
+}
+
/*
-=for apidoc sv_2uv
+=for apidoc sv_2uv_flags
Return the unsigned integer value of an SV, doing any necessary string
-conversion, magic etc. Normally used via the C<SvUV(sv)> and C<SvUVx(sv)>
-macros.
+conversion. If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
=cut
*/
UV
-Perl_sv_2uv(pTHX_ register SV *sv)
+Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
{
if (!sv)
return 0;
if (SvGMAGICAL(sv)) {
- mg_get(sv);
+ if (flags & SV_GMAGIC)
+ mg_get(sv);
if (SvIOKp(sv))
return SvUVX(sv);
if (SvNOKp(sv))
--- perl-5.8.8/doop.c.U27391 2006-01-08 15:58:53.000000000 -0500
+++ perl-5.8.8/doop.c 2006-06-01 18:43:19.000000000 -0400
@@ -1171,8 +1171,8 @@
if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */
- lsave = lc = SvPV_const(left, leftlen);
- rsave = rc = SvPV_const(right, rightlen);
+ lsave = lc = SvPV_nomg_const(left, leftlen);
+ rsave = rc = SvPV_nomg_const(right, rightlen);
len = leftlen < rightlen ? leftlen : rightlen;
lensave = len;
if ((left_utf || right_utf) && (sv == left || sv == right)) {
@@ -1180,9 +1180,7 @@
Newxz(dc, needlen + 1, char);
}
else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
- /* Fix this to nong when change 22613 is integrated.
- (Which in turn awaits merging sv_2iv and sv_2uv) */
- dc = SvPV_force_nolen(sv);
+ dc = SvPV_force_nomg_nolen(sv);
if (SvLEN(sv) < (STRLEN)(len + 1)) {
dc = SvGROW(sv, (STRLEN)(len + 1));
(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);

12
perl-5.8.8-U27426.patch
View File

@ -1,12 +0,0 @@
--- perl-5.8.8/perl.c.U27426 2006-06-01 17:04:25.000000000 -0400
+++ perl-5.8.8/perl.c 2006-06-01 19:00:57.000000000 -0400
@@ -3076,8 +3076,7 @@
PL_minus_F = TRUE;
PL_splitstr = ++s;
while (*s && !isSPACE(*s)) ++s;
- *s = '\0';
- PL_splitstr = savepv(PL_splitstr);
+ PL_splitstr = savepvn(PL_splitstr, s - PL_splitstr);
return s;
case 'a':
PL_minus_a = TRUE;

1109
perl-5.8.8-U27509.patch
View File

File diff suppressed because it is too large Load Diff

115
perl-5.8.8-U27512.patch
View File

@ -1,115 +0,0 @@
--- perl-5.8.8/sv.c.U27512 2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/sv.c 2006-06-01 19:13:32.000000000 -0400
@@ -7993,6 +7993,52 @@
return rv;
}
+/* This is a hack to cope with reblessing from class with overloading magic to
+ one without (or the other way). Search for every reference pointing to the
+ object. Can't use S_visit() because we would need to pass a parameter to
+ our function. */
+static void
+S_reset_amagic(pTHX_ SV *rv, const bool on) {
+ /* It is assumed that you've already turned magic on/off on rv */
+ SV* sva;
+ SV *const target = SvRV(rv);
+ /* Less 1 for the reference we've already dealt with. */
+ U32 how_many = SvREFCNT(target) - 1;
+ MAGIC *mg;
+
+ if (SvMAGICAL(target) && (mg = mg_find(target, PERL_MAGIC_backref))) {
+ /* Back referneces also need to be found, but aren't part of the
+ target's reference count. */
+ how_many += 1 + av_len((AV*)mg->mg_obj);
+ }
+
+ if (!how_many) {
+ /* There was only 1 reference to this object. */
+ return;
+ }
+
+ for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+ register const SV * const svend = &sva[SvREFCNT(sva)];
+ register SV* sv;
+ for (sv = sva + 1; sv < svend; ++sv) {
+ if (SvTYPE(sv) != SVTYPEMASK
+ && (sv->sv_flags & SVf_ROK) == SVf_ROK
+ && SvREFCNT(sv)
+ && SvRV(sv) == target
+ && sv != rv) {
+ if (on)
+ SvAMAGIC_on(sv);
+ else
+ SvAMAGIC_off(sv);
+ if (--how_many == 0) {
+ /* We have found them all. */
+ return;
+ }
+ }
+ }
+ }
+}
+
/*
=for apidoc sv_bless
@@ -8025,10 +8071,17 @@
(void)SvUPGRADE(tmpRef, SVt_PVMG);
SvSTASH_set(tmpRef, (HV*)SvREFCNT_inc(stash));
- if (Gv_AMG(stash))
- SvAMAGIC_on(sv);
- else
- SvAMAGIC_off(sv);
+ if (Gv_AMG(stash)) {
+ if (!SvAMAGIC(sv)) {
+ SvAMAGIC_on(sv);
+ S_reset_amagic(aTHX_ sv, TRUE);
+ }
+ } else {
+ if (SvAMAGIC(sv)) {
+ SvAMAGIC_off(sv);
+ S_reset_amagic(aTHX_ sv, FALSE);
+ }
+ }
if(SvSMAGICAL(tmpRef))
if(mg_find(tmpRef, PERL_MAGIC_ext) || mg_find(tmpRef, PERL_MAGIC_uvar))
--- perl-5.8.8/proto.h.U27512 2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/proto.h 2006-06-01 19:13:32.000000000 -0400
@@ -1875,6 +1875,7 @@
#
STATIC bool S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, const U8 **sp, const U8 *start, const U8 *send);
STATIC bool S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 offsetp, const U8 *s, const U8 *start);
+STATIC void S_reset_amagic(pTHX_ SV *rv, const bool on);
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
--- perl-5.8.8/embed.h.U27512 2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/embed.h 2006-06-01 19:13:32.000000000 -0400
@@ -1348,6 +1348,7 @@
#ifdef PERL_CORE
#define utf8_mg_pos S_utf8_mg_pos
#define utf8_mg_pos_init S_utf8_mg_pos_init
+#define reset_amagic S_reset_amagic
#endif
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
@@ -3390,6 +3391,7 @@
#ifdef PERL_CORE
#define utf8_mg_pos(a,b,c,d,e,f,g,h,i) S_utf8_mg_pos(aTHX_ a,b,c,d,e,f,g,h,i)
#define utf8_mg_pos_init(a,b,c,d,e,f,g) S_utf8_mg_pos_init(aTHX_ a,b,c,d,e,f,g)
+#define reset_amagic(a,b) S_reset_amagic(aTHX_ a,b)
#endif
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
--- perl-5.8.8/embed.fnc.U27512 2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/embed.fnc 2006-06-01 19:13:32.000000000 -0400
@@ -1276,6 +1276,7 @@
s |bool |utf8_mg_pos_init |NN SV *sv|NN MAGIC **mgp \
|NN STRLEN **cachep|I32 i|I32 offsetp \
|NN const U8 *s|NN const U8 *start
+s |void |reset_amagic |NN SV *rv|const bool on
#endif
#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)

128
perl-5.8.8-U27604.patch
View File

@ -1,128 +0,0 @@
--- /dev/null 2006-06-01 12:59:27.771303750 -0400
+++ perl-5.8.8/t/op/regexp_qr.t 2006-06-01 19:24:53.000000000 -0400
@@ -0,0 +1,10 @@
+#!./perl
+
+$qr = 1;
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
+ if (-r $file) {
+ do $file;
+ exit;
+ }
+}
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";
--- perl-5.8.8/t/op/regexp.t.U27604 2001-10-27 14:09:24.000000000 -0400
+++ perl-5.8.8/t/op/regexp.t 2006-06-01 19:24:53.000000000 -0400
@@ -49,6 +49,7 @@
$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
$ffff = chr(0xff) x 2;
$nulnul = "\0" x 2;
+$OP = $qr ? 'qr' : 'm';
$| = 1;
print "1..$numtests\n# $iters iterations\n";
@@ -73,7 +74,7 @@
$result =~ s/B//i unless $skip;
for $study ('', 'study \$subject') {
$c = $iters;
- eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
+ eval "$study; \$match = (\$subject =~ $OP$pat) while \$c--; \$got = \"$repl\";";
chomp( $err = $@ );
if ($result eq 'c') {
if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
--- perl-5.8.8/regexec.c.U27604 2006-01-08 15:59:30.000000000 -0500
+++ perl-5.8.8/regexec.c 2006-06-01 19:24:53.000000000 -0400
@@ -412,6 +412,7 @@
I32 ml_anch;
register char *other_last = Nullch; /* other substr checked before this */
char *check_at = Nullch; /* check substr found at this pos */
+ const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
#ifdef DEBUGGING
const char * const i_strpos = strpos;
SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
@@ -473,7 +474,7 @@
if (prog->reganch & ROPT_ANCH) { /* Match at beg-of-str or after \n */
ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
|| ( (prog->reganch & ROPT_ANCH_BOL)
- && !PL_multiline ) ); /* Check after \n? */
+ && !multiline ) ); /* Check after \n? */
if (!ml_anch) {
if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
@@ -568,11 +569,11 @@
else if (prog->reganch & ROPT_CANY_SEEN)
s = fbm_instr((U8*)(s + start_shift),
(U8*)(strend - end_shift),
- check, PL_multiline ? FBMrf_MULTILINE : 0);
+ check, multiline ? FBMrf_MULTILINE : 0);
else
s = fbm_instr(HOP3(s, start_shift, strend),
HOP3(strend, -end_shift, strbeg),
- check, PL_multiline ? FBMrf_MULTILINE : 0);
+ check, multiline ? FBMrf_MULTILINE : 0);
/* Update the count-of-usability, remove useless subpatterns,
unshift s. */
@@ -643,7 +644,7 @@
HOP3(HOP3(last1, prog->anchored_offset, strend)
+ SvCUR(must), -(SvTAIL(must)!=0), strbeg),
must,
- PL_multiline ? FBMrf_MULTILINE : 0
+ multiline ? FBMrf_MULTILINE : 0
);
DEBUG_r(PerlIO_printf(Perl_debug_log,
"%s anchored substr \"%s%.*s%s\"%s",
@@ -704,7 +705,7 @@
s = fbm_instr((unsigned char*)s,
(unsigned char*)last + SvCUR(must)
- (SvTAIL(must)!=0),
- must, PL_multiline ? FBMrf_MULTILINE : 0);
+ must, multiline ? FBMrf_MULTILINE : 0);
/* FIXME - DEBUG_EXECUTE_r if that is merged to maint */
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
(s ? "Found" : "Contradicts"),
@@ -1639,6 +1640,7 @@
char *scream_olds;
SV* oreplsv = GvSV(PL_replgv);
const bool do_utf8 = DO_UTF8(sv);
+ const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
#ifdef DEBUGGING
SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
@@ -1756,7 +1758,7 @@
if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
if (s == startpos && regtry(prog, startpos))
goto got_it;
- else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
+ else if (multiline || (prog->reganch & ROPT_IMPLICIT)
|| (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
{
char *end;
@@ -1889,7 +1891,7 @@
end_shift, &scream_pos, 0))
: (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
(unsigned char*)strend, must,
- PL_multiline ? FBMrf_MULTILINE : 0))) ) {
+ multiline ? FBMrf_MULTILINE : 0))) ) {
/* we may be pointing at the wrong string */
if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
s = strbeg + (s - SvPVX_const(sv));
@@ -1990,7 +1992,7 @@
if (SvTAIL(float_real)) {
if (memEQ(strend - len + 1, little, len - 1))
last = strend - len + 1;
- else if (!PL_multiline)
+ else if (!multiline)
last = memEQ(strend - len, little, len)
? strend - len : Nullch;
else
--- perl-5.8.8/MANIFEST.U27604 2006-01-31 18:27:53.000000000 -0500
+++ perl-5.8.8/MANIFEST 2006-06-01 19:24:52.000000000 -0400
@@ -2802,6 +2802,7 @@
t/op/ref.t See if refs and objects work
t/op/regexp_noamp.t See if regular expressions work with optimizations
t/op/regexp.t See if regular expressions work
+t/op/regexp_qr.t See if regular expressions work as qr//
t/op/regmesg.t See if one can get regular expression errors
t/op/repeat.t See if x operator works
t/op/re_tests Regular expressions for regexp.t

41
perl-5.8.8-U27605.patch
View File

@ -1,41 +0,0 @@
--- perl-5.8.8/mg.c.U27605 2006-01-27 15:23:21.000000000 -0500
+++ perl-5.8.8/mg.c 2006-06-01 19:37:17.000000000 -0400
@@ -2520,10 +2520,10 @@
#endif
/* PL_origalen is set in perl_parse(). */
s = SvPV_force(sv,len);
- if (len >= (STRLEN)PL_origalen) {
- /* Longer than original, will be truncated. */
- Copy(s, PL_origargv[0], PL_origalen, char);
- PL_origargv[0][PL_origalen - 1] = 0;
+ if (len >= (STRLEN)PL_origalen-1) {
+ /* Longer than original, will be truncated. We assume that
+ * PL_origalen bytes are available. */
+ Copy(s, PL_origargv[0], PL_origalen-1, char);
}
else {
/* Shorter than original, will be padded. */
@@ -2536,9 +2536,10 @@
* --jhi */
(int)' ',
PL_origalen - len - 1);
- for (i = 1; i < PL_origargc; i++)
- PL_origargv[i] = 0;
}
+ PL_origargv[0][PL_origalen-1] = 0;
+ for (i = 1; i < PL_origargc; i++)
+ PL_origargv[i] = 0;
UNLOCK_DOLLARZERO_MUTEX;
break;
#endif
--- perl-5.8.8/perl.c.U27605 2006-06-01 19:00:57.000000000 -0400
+++ perl-5.8.8/perl.c 2006-06-01 19:37:17.000000000 -0400
@@ -1561,7 +1561,7 @@
}
}
}
- PL_origalen = s - PL_origargv[0];
+ PL_origalen = s - PL_origargv[0] + 1;
}
if (PL_do_undump) {

61
perl-5.8.8-U27914.patch
View File

@ -1,61 +0,0 @@
--- perl-5.8.8/t/op/local.t.U27914 2006-01-03 10:11:35.000000000 -0500
+++ perl-5.8.8/t/op/local.t 2006-06-01 19:49:54.000000000 -0400
@@ -4,7 +4,7 @@
chdir 't' if -d 't';
require './test.pl';
}
-plan tests => 81;
+plan tests => 85;
my $list_assignment_supported = 1;
@@ -313,3 +313,19 @@
{ local @x{c,d,e}; }
ok(! exists $x{c});
}
+
+# local() and readonly magic variables
+
+eval { local $1 = 1 };
+like($@, qr/Modification of a read-only value attempted/);
+
+eval { for ($1) { local $_ = 1 } };
+like($@, qr/Modification of a read-only value attempted/);
+
+# make sure $1 is still read-only
+eval { for ($1) { local $_ = 1 } };
+is($@, "");
+
+# The s/// adds 'g' magic to $_, but it should remain non-readonly
+eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
+is($@, "");
--- perl-5.8.8/scope.c.U27914 2005-09-30 09:56:51.000000000 -0400
+++ perl-5.8.8/scope.c 2006-06-01 19:49:54.000000000 -0400
@@ -205,9 +205,9 @@
register SV * const sv = *sptr = NEWSV(0,0);
if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
+ MAGIC *mg;
sv_upgrade(sv, SvTYPE(osv));
if (SvGMAGICAL(osv)) {
- MAGIC* mg;
const bool oldtainted = PL_tainted;
mg_get(osv); /* note, can croak! */
if (PL_tainting && PL_tainted &&
@@ -220,6 +220,16 @@
PL_tainted = oldtainted;
}
SvMAGIC_set(sv, SvMAGIC(osv));
+ /* if it's a special scalar or if it has no 'set' magic,
+ * propagate the SvREADONLY flag. --rgs 20030922 */
+ for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+ if (mg->mg_type == '\0'
+ || !(mg->mg_virtual && mg->mg_virtual->svt_set))
+ {
+ SvFLAGS(sv) |= SvREADONLY(osv);
+ break;
+ }
+ }
SvFLAGS(sv) |= SvMAGICAL(osv);
/* XXX SvMAGIC() is *shared* between osv and sv. This can
* lead to coredumps when both SVs are destroyed without one

325
perl-5.8.8-U28775.patch
View File

@ -1,325 +0,0 @@
--- perl-5.8.8/ext/B/B/Deparse.pm-28
+++ perl-5.8.8/ext/B/B/Deparse.pm
@@ -19,7 +19,7 @@
CVf_METHOD CVf_LOCKED CVf_LVALUE CVf_ASSERTION
PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE
PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED);
-$VERSION = 0.71;
+$VERSION = 0.71_01;
use strict;
use vars qw/$AUTOLOAD/;
use warnings ();
@@ -1711,6 +1711,32 @@
return $self->{'curcv'}->PADLIST->ARRAYelt(1)->ARRAYelt($targ);
}
+sub anon_hash_or_list {
+ my $self = shift;
+ my $op = shift;
+
+ my($pre, $post) = @{{"anonlist" => ["[","]"],
+ "anonhash" => ["{","}"]}->{$op->name}};
+ my($expr, @exprs);
+ $op = $op->first->sibling; # skip pushmark
+ for (; !null($op); $op = $op->sibling) {
+ $expr = $self->deparse($op, 6);
+ push @exprs, $expr;
+ }
+ return $pre . join(", ", @exprs) . $post;
+}
+
+sub pp_anonlist {
+ my ($self, $op) = @_;
+ if ($op->flags & OPf_SPECIAL) {
+ return $self->anon_hash_or_list($op);
+ }
+ warn "Unexpected op pp_" . $op->name() . " without OPf_SPECIAL";
+ return 'XXX';
+}
+
+*pp_anonhash = \&pp_anonlist;
+
sub pp_refgen {
my $self = shift;
my($op, $cx) = @_;
@@ -1718,15 +1744,7 @@
if ($kid->name eq "null") {
$kid = $kid->first;
if ($kid->name eq "anonlist" || $kid->name eq "anonhash") {
- my($pre, $post) = @{{"anonlist" => ["[","]"],
- "anonhash" => ["{","}"]}->{$kid->name}};
- my($expr, @exprs);
- $kid = $kid->first->sibling; # skip pushmark
- for (; !null($kid); $kid = $kid->sibling) {
- $expr = $self->deparse($kid, 6);
- push @exprs, $expr;
- }
- return $pre . join(", ", @exprs) . $post;
+ return $self->anon_hash_or_list($op);
} elsif (!null($kid->sibling) and
$kid->sibling->name eq "anoncode") {
return "sub " .
--- perl-5.8.8/ext/B/t/concise-xs.t.orig 2007-06-22 13:35:00.000000000 -0400
+++ perl-5.8.8/ext/B/t/concise-xs.t 2007-06-22 13:35:22.000000000 -0400
@@ -95,7 +95,7 @@
# One 5.009-only test to go when no 6; is integrated (25344)
use Test::More tests => ( 1 * !!$Config::Config{useithreads}
+ 1 * ($] > 5.009)
- + 778);
+ + 781);
require_ok("B::Concise");
--- perl-5.8.8/ext/B/t/f_map.t-7
+++ perl-5.8.8/ext/B/t/f_map.t
@@ -512,14 +512,13 @@
# 9 <#> gvsv[*_] s
# a <1> lc[t4] sK/1
# b <$> const[IV 1] s
-# c <@> anonhash sKRM/1
-# d <1> srefgen sK/1
+# c <@> anonhash sK*/1
# goto 7
-# e <0> pushmark s
-# f <#> gv[*hashes] s
-# g <1> rv2av[t2] lKRM*/1
-# h <2> aassign[t8] KS/COMMON
-# i <1> leavesub[1 ref] K/REFC,1
+# d <0> pushmark s
+# e <#> gv[*hashes] s
+# f <1> rv2av[t2] lKRM*/1
+# g <2> aassign[t8] KS/COMMON
+# h <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 601 (eval 32):1) v
# 2 <0> pushmark s
@@ -532,12 +531,11 @@
# 9 <$> gvsv(*_) s
# a <1> lc[t2] sK/1
# b <$> const(IV 1) s
-# c <@> anonhash sKRM/1
-# d <1> srefgen sK/1
+# c <@> anonhash sK*/1
# goto 7
-# e <0> pushmark s
-# f <$> gv(*hashes) s
-# g <1> rv2av[t1] lKRM*/1
-# h <2> aassign[t5] KS/COMMON
-# i <1> leavesub[1 ref] K/REFC,1
+# d <0> pushmark s
+# e <$> gv(*hashes) s
+# f <1> rv2av[t1] lKRM*/1
+# g <2> aassign[t5] KS/COMMON
+# h <1> leavesub[1 ref] K/REFC,1
EONT_EONT
--- perl-5.8.8/ext/B/t/f_sort.t-9
+++ perl-5.8.8/ext/B/t/f_sort.t
@@ -516,25 +516,24 @@
# e </> match(/"=(\\d+)"/) l/RTIME
# f <#> gvsv[*_] s
# g <1> uc[t17] sK/1
-# h <@> anonlist sKRM/1
-# i <1> srefgen sK/1
-# j <@> leave lKP
+# h <@> anonlist sK*/1
+# i <@> leave lKP
# goto 9
-# k <@> sort lKMS*
-# l <@> mapstart lK*
-# m <|> mapwhile(other->n)[t26] lK
-# n <#> gv[*_] s
-# o <1> rv2sv sKM/DREFAV,1
-# p <1> rv2av[t4] sKR/1
-# q <$> const[IV 0] s
-# r <2> aelem sK/2
+# j <@> sort lKMS*
+# k <@> mapstart lK*
+# l <|> mapwhile(other->m)[t26] lK
+# m <#> gv[*_] s
+# n <1> rv2sv sKM/DREFAV,1
+# o <1> rv2av[t4] sKR/1
+# p <$> const[IV 0] s
+# q <2> aelem sK/2
# - <@> scope lK
-# goto m
-# s <0> pushmark s
-# t <#> gv[*new] s
-# u <1> rv2av[t2] lKRM*/1
-# v <2> aassign[t27] KS/COMMON
-# w <1> leavesub[1 ref] K/REFC,1
+# goto l
+# r <0> pushmark s
+# s <#> gv[*new] s
+# t <1> rv2av[t2] lKRM*/1
+# u <2> aassign[t27] KS/COMMON
+# v <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 609 (eval 34):3) v
# 2 <0> pushmark s
@@ -552,25 +551,24 @@
# e </> match(/"=(\\d+)"/) l/RTIME
# f <$> gvsv(*_) s
# g <1> uc[t9] sK/1
-# h <@> anonlist sKRM/1
-# i <1> srefgen sK/1
-# j <@> leave lKP
+# h <@> anonlist sK*/1
+# i <@> leave lKP
# goto 9
-# k <@> sort lKMS*
-# l <@> mapstart lK*
-# m <|> mapwhile(other->n)[t12] lK
-# n <$> gv(*_) s
-# o <1> rv2sv sKM/DREFAV,1
-# p <1> rv2av[t2] sKR/1
-# q <$> const(IV 0) s
-# r <2> aelem sK/2
+# j <@> sort lKMS*
+# k <@> mapstart lK*
+# l <|> mapwhile(other->m)[t12] lK
+# m <$> gv(*_) s
+# n <1> rv2sv sKM/DREFAV,1
+# o <1> rv2av[t2] sKR/1
+# p <$> const(IV 0) s
+# q <2> aelem sK/2
# - <@> scope lK
-# goto m
-# s <0> pushmark s
-# t <$> gv(*new) s
-# u <1> rv2av[t1] lKRM*/1
-# v <2> aassign[t13] KS/COMMON
-# w <1> leavesub[1 ref] K/REFC,1
+# goto l
+# r <0> pushmark s
+# s <$> gv(*new) s
+# t <1> rv2av[t1] lKRM*/1
+# u <2> aassign[t13] KS/COMMON
+# v <1> leavesub[1 ref] K/REFC,1
EONT_EONT
--- perl-5.8.8/ext/Devel/Peek/t/Peek.t-8
+++ perl-5.8.8/ext/Devel/Peek/t/Peek.t
@@ -165,7 +165,7 @@
FLAGS = \\(ROK\\)
RV = $ADDR
SV = PVAV\\($ADDR\\) at $ADDR
- REFCNT = 2
+ REFCNT = 1
FLAGS = \\(\\)
IV = 0
NV = 0
@@ -188,7 +188,7 @@
FLAGS = \\(ROK\\)
RV = $ADDR
SV = PVHV\\($ADDR\\) at $ADDR
- REFCNT = 2
+ REFCNT = 1
FLAGS = \\(SHAREKEYS\\)
IV = 1
NV = $FLOAT
@@ -284,7 +284,7 @@
FLAGS = \\(ROK\\)
RV = $ADDR
SV = PVHV\\($ADDR\\) at $ADDR
- REFCNT = 2
+ REFCNT = 1
FLAGS = \\(OBJECT,SHAREKEYS\\)
IV = 0
NV = 0
@@ -353,7 +353,7 @@
FLAGS = \\(ROK\\)
RV = $ADDR
SV = PVHV\\($ADDR\\) at $ADDR
- REFCNT = 2
+ REFCNT = 1
FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
UV = 1
NV = $FLOAT
@@ -379,7 +379,7 @@
FLAGS = \\(ROK\\)
RV = $ADDR
SV = PVHV\\($ADDR\\) at $ADDR
- REFCNT = 2
+ REFCNT = 1
FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
UV = 1
NV = 0
--- perl-5.8.8/op.c-137
+++ perl-5.8.8/op.c
@@ -2230,6 +2230,8 @@
pp_pushmark();
CALLRUNOPS(aTHX);
PL_op = curop;
+ assert (!(curop->op_flags & OPf_SPECIAL));
+ assert(curop->op_type == OP_RANGE);
pp_anonlist();
PL_tmps_floor = oldtmps_floor;
@@ -4861,15 +4863,13 @@
OP *
Perl_newANONLIST(pTHX_ OP *o)
{
- return newUNOP(OP_REFGEN, 0,
- mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
+ return convert(OP_ANONLIST, OPf_SPECIAL, o);
}
OP *
Perl_newANONHASH(pTHX_ OP *o)
{
- return newUNOP(OP_REFGEN, 0,
- mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
+ return convert(OP_ANONHASH, OPf_SPECIAL, o);
}
OP *
--- perl-5.8.8/op.h-26
+++ perl-5.8.8/op.h
@@ -103,5 +103,7 @@
* (runtime property) */
/* On OP_AELEMFAST, indiciates pad var */
+ /* On OP_ANONHASH and OP_ANONLIST, create a
+ reference to the new anon hash or array */
/* old names; don't use in new code, but don't break them, either */
#define OPf_LIST OPf_WANT_LIST
--- perl-5.8.8/pp.c-101
+++ perl-5.8.8/pp.c
@@ -4036,16 +4036,17 @@
{
dSP; dMARK; dORIGMARK;
const I32 items = SP - MARK;
- SV * const av = sv_2mortal((SV*)av_make(items, MARK+1));
+ SV * const av = (SV *) av_make(items, MARK+1);
SP = ORIGMARK; /* av_make() might realloc stack_sp */
- XPUSHs(av);
+ XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
+ ? newRV_noinc(av) : av));
RETURN;
}
PP(pp_anonhash)
{
dSP; dMARK; dORIGMARK;
- HV* const hv = (HV*)sv_2mortal((SV*)newHV());
+ HV* const hv = newHV();
while (MARK < SP) {
SV * const key = *++MARK;
@@ -4057,7 +4058,8 @@
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
- XPUSHs((SV*)hv);
+ XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
+ ? newRV_noinc((SV*) hv) : (SV*)hv));
RETURN;
}

26
perl-5.8.8-U34297_C28006.patch
View File

@ -1,26 +0,0 @@
--- perl-5.8.8/pp.c.U34297_C28006 2006-07-13 12:40:37.000000000 -0400
+++ perl-5.8.8/pp.c 2006-07-13 13:03:19.000000000 -0400
@@ -2949,7 +2949,22 @@
dSP; dTARGET;
SV *sv = TOPs;
- if (DO_UTF8(sv))
+ if (SvAMAGIC(sv)) {
+ /* For an overloaded scalar, we can't know in advance if it's going to
+ be UTF-8 or not. Also, we can't call sv_len_utf8 as it likes to
+ cache the length. Maybe that should be a documented feature of it.
+ */
+ STRLEN len;
+ const char *const p = SvPV_const(sv, len);
+
+ if (DO_UTF8(sv)) {
+ SETi(utf8_length((U8*)p, (U8*)p + len));
+ }
+ else
+ SETi(len);
+
+ }
+ else if (DO_UTF8(sv))
SETi(sv_len_utf8(sv));
else
SETi(sv_len(sv));

123
perl-5.8.8-USE_MM_LD_RUN_PATH.patch
View File

@ -1,123 +0,0 @@
--- perl-5.8.8-RC1/lib/ExtUtils/MakeMaker.pm.USE_MM_LD_RUN_PATH 2006-01-20 15:51:09.000000000 -0500
+++ perl-5.8.8-RC1/lib/ExtUtils/MakeMaker.pm 2006-01-20 16:25:43.000000000 -0500
@@ -233,7 +233,7 @@
PERL_SRC PERM_RW PERM_RWX
PL_FILES PM PM_FILTER PMLIBDIRS POLLUTE PPM_INSTALL_EXEC
PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
- SIGN SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
+ SKIP TYPEMAPS USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS XSOPT XSPROTOARG
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
tool_autosplit
@@ -369,7 +369,27 @@
print join(" ", map { "perl($_)>=$self->{PREREQ_PM}->{$_} " }
sort keys %{$self->{PREREQ_PM}}), "\n";
exit 0;
- }
+ }
+
+ # USE_MM_LD_RUN_PATH - another RedHatism to disable automatic RPATH generation
+ if ( ( ! $self->{USE_MM_LD_RUN_PATH} )
+ &&( ("@ARGV" =~ /\bUSE_MM_LD_RUN_PATH(=([01]))?\b/)
+ ||( exists( $ENV{USE_MM_LD_RUN_PATH} )
+ &&( $ENV{USE_MM_LD_RUN_PATH} =~ /([01])?$/ )
+ )
+ )
+ )
+ {
+ my $v = $1;
+ if( $v )
+ {
+ $v = ($v=~/=([01])$/)[0];
+ }else
+ {
+ $v = 1;
+ };
+ $self->{USE_MM_LD_RUN_PATH}=$v;
+ };
print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose;
if (-f "MANIFEST" && ! -f "Makefile"){
@@ -1373,13 +1393,13 @@
This is the root directory into which the code will be installed. It
I<prepends itself to the normal prefix>. For example, if your code
-would normally go into F</usr/local/lib/perl> you could set DESTDIR=~/tmp/
-and installation would go into F<~/tmp/usr/local/lib/perl>.
+would normally go into /usr/local/lib/perl you could set DESTDIR=~/myperl/
+and installation would go into ~/myperl/usr/local/lib/perl.
This is primarily of use for people who repackage Perl modules.
NOTE: Due to the nature of make, it is important that you put the trailing
-slash on your DESTDIR. F<~/tmp/> not F<~/tmp>.
+slash on your DESTDIR. F<"~/myperl/"> not F<"~/myperl">.
=item DIR
@@ -2057,6 +2077,40 @@
precedence, even if it isn't listed in TYPEMAPS. The default system
typemap has lowest precedence.
+=item USE_MM_LD_RUN_PATH
+
+boolean
+The Red Hat perl MakeMaker distribution differs from the standard
+upstream release in that it disables use of the MakeMaker generated
+LD_RUN_PATH by default, UNLESS this attribute is specified , or the
+USE_MM_LD_RUN_PATH environment variable is set during the MakeMaker run.
+
+The upstream MakeMaker will set the ld(1) environment variable LD_RUN_PATH
+to the concatenation of every -L ld(1) option directory in which a -l ld(1)
+option library is found, which is used as the ld(1) -rpath option if none
+is specified. This means that, if your application builds shared libraries
+and your MakeMaker application links to them, that the absolute paths of the
+libraries in the build tree will be inserted into the RPATH header of all
+MakeMaker generated binaries, and that such binaries will be unable to link
+to these libraries if they do not still reside in the build tree directories
+(unlikely) or in the system library directories (/lib or /usr/lib), regardless
+of any LD_LIBRARY_PATH setting. So if you specified -L../mylib -lmylib , and
+ your 'libmylib.so' gets installed into /some_directory_other_than_usr_lib,
+ your MakeMaker application will be unable to link to it, even if LD_LIBRARY_PATH
+is set to include /some_directory_other_than_usr_lib, because RPATH overrides
+LD_LIBRARY_PATH.
+
+So for Red Hat MakeMaker builds LD_RUN_PATH is NOT generated by default for
+every link. You can still use explicit -rpath ld options or the LD_RUN_PATH
+environment variable during the build to generate an RPATH for the binaries.
+
+You can set the USE_MM_LD_RUN_PATH attribute to 1 on the MakeMaker command
+line or in the WriteMakefile arguments to enable generation of LD_RUN_PATH
+for every link command.
+
+USE_MM_LD_RUN_PATH will default to 1 (LD_RUN_PATH will be used) IF the
+$USE_MM_LD_RUN_PATH environment variable is set during a MakeMaker run.
+
=item VENDORPREFIX
Like PERLPREFIX, but only for the vendor install locations.
--- perl-5.8.8-RC1/lib/ExtUtils/MM_Unix.pm.USE_MM_LD_RUN_PATH 2005-10-21 10:11:03.000000000 -0400
+++ perl-5.8.8-RC1/lib/ExtUtils/MM_Unix.pm 2006-01-20 16:20:25.000000000 -0500
@@ -941,7 +941,7 @@
}
my $ld_run_path_shell = "";
- if ($self->{LD_RUN_PATH} ne "") {
+ if (($self->{LD_RUN_PATH} ne "") && ($self->{USE_MM_LD_RUN_PATH})) {
$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
}
--- perl-5.8.8-RC1/lib/ExtUtils/Liblist.pm.USE_MM_LD_RUN_PATH 2003-04-07 14:58:17.000000000 -0400
+++ perl-5.8.8-RC1/lib/ExtUtils/Liblist.pm 2006-01-20 16:21:57.000000000 -0500
@@ -87,6 +87,11 @@
in LDLOADLIBS. It is passed as an environment variable to the process
that links the shared library.
+Red Hat extension: This generation of LD_RUN_PATH is disabled by default.
+To use the generated LD_RUN_PATH for all links, set the USE_MM_LD_RUN_PATH
+MakeMaker object attribute / argument, (or set the $USE_MM_LD_RUN_PATH
+environment variable).
+
=head2 BSLOADLIBS
List of those libraries that are needed but can be linked in

34
perl-5.8.8-bug24254.patch
View File

@ -1,34 +0,0 @@
diff -up perl-5.8.8/cop.h.BAD perl-5.8.8/cop.h
--- perl-5.8.8/cop.h.BAD 2007-10-18 09:54:16.000000000 -0400
+++ perl-5.8.8/cop.h 2007-10-18 09:56:17.000000000 -0400
@@ -286,9 +286,14 @@ struct block_loop {
#define POPLOOP(cx) \
SvREFCNT_dec(cx->blk_loop.iterlval); \
if (CxITERVAR(cx)) { \
- SV **s_v_p = CxITERVAR(cx); \
- sv_2mortal(*s_v_p); \
- *s_v_p = cx->blk_loop.itersave; \
+ if (SvPADMY(cx->blk_loop.itersave)) { \
+ SV **s_v_p = CxITERVAR(cx); \
+ sv_2mortal(*s_v_p); \
+ *s_v_p = cx->blk_loop.itersave; \
+ } \
+ else { \
+ SvREFCNT_dec(cx->blk_loop.itersave); \
+ } \
} \
if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
SvREFCNT_dec(cx->blk_loop.iterary);
diff -up perl-5.8.8/t/op/local.t.BAD perl-5.8.8/t/op/local.t
--- perl-5.8.8/t/op/local.t.BAD 2007-10-18 10:53:10.000000000 -0400
+++ perl-5.8.8/t/op/local.t 2007-10-18 10:53:44.000000000 -0400
@@ -324,7 +324,7 @@ like($@, qr/Modification of a read-only
# make sure $1 is still read-only
eval { for ($1) { local $_ = 1 } };
-is($@, "");
+like($@, qr/Modification of a read-only value attempted/);
# The s/// adds 'g' magic to $_, but it should remain non-readonly
eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
diff -up perl-5.8.8/op.c.BAD perl-5.8.8/op.c

53
perl-5.8.8-bz178343.patch
View File

@ -1,53 +0,0 @@
--- perl-5.8.8-RC1/Configure.bz178343 2006-01-30 19:42:47.000000000 -0500
+++ perl-5.8.8-RC1/Configure 2006-01-30 20:04:53.000000000 -0500
@@ -20279,6 +20279,17 @@
chmod +x Cppsym.try
$eunicefix Cppsym.try
./Cppsym < Cppsym.know > Cppsym.true
+: Add in any cpp "predefined macros" :
+tHdrH=`mktemp ./XXXXXX`
+rm -f $tHdrH'.h' $tHdrH
+touch $tHdrH'.h'
+if cpp -dM $tHdrH'.h' > $tHdrH'_cppsym.h' && [ -s $tHdrH'_cppsym.h' ] ; then
+ sed 's/#define[\ \ ]*//;s/[\ \ ].*$//' < $tHdrH'_cppsym.h' > $tHdrH'_cppsym.real';
+ if [ -s $tHdrH'_cppsym.real' ]; then
+ cat $tHdrH'_cppsym.real' Cppsym.know | sort | uniq | ./Cppsym | sort | uniq > Cppsym.true
+ fi
+fi
+rm -f $tHdrH'.h' $tHdrH'_cppsym.h' $tHdrH'_cppsym.real'
: now check the C compiler for additional symbols
postprocess_cc_v=''
case "$osname" in
--- perl-5.8.8-RC1/utils/h2ph.PL.bz178343 2006-01-13 12:56:47.000000000 -0500
+++ perl-5.8.8-RC1/utils/h2ph.PL 2006-01-30 20:01:15.000000000 -0500
@@ -778,8 +778,16 @@
if ($opt_D) {
print PREAMBLE "# $_=$define{$_}\n";
}
-
- if ($define{$_} =~ /^(\d+)U?L{0,2}$/i) {
+ if ($define{$_} =~ /^\((.*)\)$/) {
+ # parenthesized value: d=(v)
+ $define{$_} = $1;
+ };
+ if ($define{$_} =~ /^([+-]?(\d+)?\.\d+([eE][+-]?\d+)?)[FL]?$/ ) {
+ # float:
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { $1 } }\n\n";
+ } elsif ($define{$_} =~ /^([+-]?\d+)U?L{0,2}$/i) {
+ # integer:
print PREAMBLE
"unless (defined &$_) { sub $_() { $1 } }\n\n";
} elsif ($define{$_} =~ /^\w+$/) {
@@ -805,9 +813,8 @@
@Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
# Split compiler pre-definitions into `key=value' pairs:
- foreach (split /\s+/, $allsymbols) {
- /(.+?)=(.+)/ and $define{$1} = $2;
-
+ while( $allsymbols=~/([^\s]+)=((\\\s|[^\s])+)/g ) {
+ $define{$1} = $2;
if ($opt_D) {
print STDERR "$_: $1 -> $2\n";
}

11
perl-5.8.8-bz183553_ubz38657.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.8/perl.c.bz183553_ubz38657 2006-02-27 12:51:49.000000000 -0500
+++ perl-5.8.8/perl.c 2006-03-01 17:18:41.000000000 -0500
@@ -3110,7 +3110,7 @@
sv_catpv(sv, start);
else {
sv_catpvn(sv, start, s-start);
- Perl_sv_catpvf(aTHX_ sv, " split(/,/,q%c%s%c)", 0, ++s, 0);
+ Perl_sv_catpvf(aTHX_ sv, " split(/,/,q(%s))", ++s);
}
s += strlen(s);
my_setenv("PERL5DB", (char *)SvPV_nolen_const(sv));

11
perl-5.8.8-bz188441.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.8/lib/CGI.pm.bz188441 2006-01-08 11:40:30.000000000 -0500
+++ perl-5.8.8/lib/CGI.pm 2006-04-12 18:49:26.000000000 -0400
@@ -2650,7 +2650,7 @@
return $url if $base;
$url .= $uri;
} elsif ($relative) {
- ($url) = $script_name =~ m!([^/]+)$!;
+ ($url) = $uri =~ m!([^/]+)$!;
} elsif ($absolute) {
$url = $uri;
}

40
perl-5.8.8-bz191416.patch
View File

@ -1,40 +0,0 @@
--- perl-5.8.8/t/lib/h2ph.pht.bz191416 2004-12-27 14:55:34.000000000 -0500
+++ perl-5.8.8/t/lib/h2ph.pht 2006-05-11 15:12:10.000000000 -0400
@@ -28,21 +28,21 @@
eval q((($a) < ($b) ? ($a) : ($b)));
}' unless defined(&MIN);
}
- if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
+ if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : undef))) {
}
- elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
+ elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : undef))) {
die("Nup, can't go on");
} else {
eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
}
undef(&WHATEVER) if defined(&WHATEVER);
- if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0) && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : 0))) {
+ if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : undef) && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : undef))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : undef))) {
eval 'sub WHATEVER () {6;}' unless defined(&WHATEVER);
}
- elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)) ) {
+ elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : undef)) ) {
eval 'sub WHATEVER () {7;}' unless defined(&WHATEVER);
}
- elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0)) ) {
+ elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : undef)) ) {
eval 'sub WHATEVER () {8;}' unless defined(&WHATEVER);
} else {
eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER);
--- perl-5.8.8/utils/h2ph.PL.bz191416 2006-05-11 15:10:52.000000000 -0400
+++ perl-5.8.8/utils/h2ph.PL 2006-05-11 15:11:49.000000000 -0400
@@ -514,7 +514,7 @@
}
} else {
if ($inif && $new !~ /defined\s*\($/) {
- $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
+ $new .= '(defined(&' . $id . ') ? &' . $id . ' : undef)';
} elsif (/^\[/) {
$new .= " \$$id";
} else {

11
perl-5.8.8-bz199736.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.8/ext/B/B/C.pm.bz199736 2006-01-13 09:47:39.000000000 -0500
+++ perl-5.8.8/ext/B/B/C.pm 2006-07-21 20:25:39.000000000 -0400
@@ -647,7 +647,7 @@
return $sym if defined $sym;
my $val= $sv->NVX;
$val .= '.00' if $val =~ /^-?\d+$/;
- $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $val));
+ $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->NVX, $val));
$svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
$xpvnvsect->index, $sv->REFCNT , $sv->FLAGS));
return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));

18547
perl-5.8.8-bz204679.patch
View File

File diff suppressed because it is too large Load Diff

11
perl-5.8.8-bz247386-file-spec-cwd.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.8/lib/File/Spec/Unix.pm.orig 2005-08-27 12:14:38.000000000 -0500
+++ perl-5.8.8/lib/File/Spec/Unix.pm 2007-07-07 22:13:51.000000000 -0500
@@ -470,7 +470,7 @@
# File::Spec subclasses use this.
sub _cwd {
require Cwd;
- Cwd::cwd();
+ Cwd::getcwd();
}

57
perl-5.8.8-bz323571.patch
View File

@ -1,57 +0,0 @@
--- perl-5.8.8.orig/regcomp.c 2006-01-08 20:59:27.000000000 +0000
+++ perl-5.8.8/regcomp.c 2007-10-19 22:49:41.000000000 +0100
@@ -136,6 +136,7 @@
I32 seen_zerolen;
I32 seen_evals;
I32 utf8;
+ I32 orig_utf8;
#if ADD_TO_REGEXEC
char *starttry; /* -Dr: where regtry was called. */
#define RExC_starttry (pRExC_state->starttry)
@@ -161,6 +162,7 @@
#define RExC_seen_zerolen (pRExC_state->seen_zerolen)
#define RExC_seen_evals (pRExC_state->seen_evals)
#define RExC_utf8 (pRExC_state->utf8)
+#define RExC_orig_utf8 (pRExC_state->orig_utf8)
#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?')
#define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \
@@ -1749,15 +1751,17 @@
if (exp == NULL)
FAIL("NULL regexp argument");
- RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
+ RExC_orig_utf8 = RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
- RExC_precomp = exp;
DEBUG_r({
if (!PL_colorset) reginitcolors();
PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
PL_colors[4],PL_colors[5],PL_colors[0],
- (int)(xend - exp), RExC_precomp, PL_colors[1]);
+ (int)(xend - exp), exp, PL_colors[1]);
});
+
+redo_first_pass:
+ RExC_precomp = exp;
RExC_flags = pm->op_pmflags;
RExC_sawback = 0;
@@ -1783,6 +1787,17 @@
RExC_precomp = Nullch;
return(NULL);
}
+ if (RExC_utf8 && !RExC_orig_utf8) {
+ STRLEN len = xend-exp;
+ DEBUG_r(PerlIO_printf(Perl_debug_log,
+ "UTF8 mismatch! Converting to utf8 for resizing and compile\n"));
+ exp = (char*)Perl_bytes_to_utf8(aTHX_ (U8*)exp, &len);
+ xend = exp + len;
+ RExC_orig_utf8 = RExC_utf8;
+ SAVEFREEPV(exp);
+ goto redo_first_pass;
+ }
+
DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
/* Small enough for pointer-storage convention?

11
perl-5.8.8-dashI.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.8-RC1/perl.c.dashI 2006-01-08 09:36:17.000000000 -0500
+++ perl-5.8.8-RC1/perl.c 2006-01-20 14:42:43.000000000 -0500
@@ -1755,7 +1755,7 @@
if (s && *s) {
STRLEN len = strlen(s);
const char * const p = savepvn(s, len);
- incpush(p, TRUE, TRUE, FALSE);
+ incpush(p, FALSE, FALSE, FALSE);
sv_catpvn(sv, "-I", 2);
sv_catpvn(sv, p, len);
sv_catpvn(sv, " ", 1);

11
perl-5.8.8-debian_fix_net_nntp.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.8/lib/Net/NNTP.pm.debian_fix_net_nntp.patch 2004-05-06 09:36:05.000000000 -0400
+++ perl-5.8.8/lib/Net/NNTP.pm 2006-02-10 14:01:30.000000000 -0500
@@ -120,7 +120,7 @@
my $nntp = shift;
my @fh;
- @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
+ @fh = (pop) if @_ == 2 || (@_ && (ref($_[0]) || ref(\$_[0]) eq 'GLOB'));
$nntp->_ARTICLE(@_)
? $nntp->read_until_dot(@fh)

11
perl-5.8.8-disable_test_hosts.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.8/lib/Net/Config.pm.orig 2007-05-07 12:35:45.000000000 -0400
+++ perl-5.8.8/lib/Net/Config.pm 2007-05-07 12:40:56.000000000 -0400
@@ -29,7 +29,7 @@
ftp_firewall => undef,
ftp_ext_passive => 0,
ftp_int_passive => 0,
- test_hosts => 1,
+ test_hosts => 0,
test_exist => 1,
);

63
perl-5.8.8-incpush.patch
View File

@ -1,63 +0,0 @@
--- perl-5.8.7/perl.c.orig 2005-04-22 17:14:27.000000000 +0300
+++ perl-5.8.7/perl.c 2005-06-17 22:31:31.000000000 +0300
@@ -109,6 +109,7 @@
#endif
static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
+STATIC void incpush_oldversion(pTHX_ char *dir);
#ifdef IAMSUID
#ifndef DOSUID
@@ -4435,6 +4436,7 @@
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
incpush(SITEARCH_EXP, FALSE, FALSE, TRUE);
+ incpush_oldversion(aTHX_ SITEARCH_EXP);
# endif
#endif
@@ -4456,6 +4458,7 @@
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
incpush(PERL_VENDORARCH_EXP, FALSE, FALSE, TRUE);
+ incpush_oldversion(aTHX_ PERL_VENDORARCH_EXP);
# endif
#endif
@@ -4497,6 +4500,36 @@
# define PERLLIB_MANGLE(s,n) (s)
#endif
+#define VERSION_DIRECTORY_STRING "/" STRINGIFY(PERL_REVISION) "." STRINGIFY(PERL_VERSION) "." STRINGIFY(PERL_SUBVERSION)
+STATIC void
+incpush_oldversion(pTHX_ char *dir)
+{
+#ifdef PERL_INC_VERSION_LIST
+ const char *incverlist[] = { PERL_INC_VERSION_LIST };
+ const char **incver;
+ const char *verdir;
+
+ verdir = strstr(dir, VERSION_DIRECTORY_STRING);
+ if (!verdir)
+ return;
+
+ for (incver = incverlist; *incver; incver++) {
+ char *new_dir = malloc(strlen(dir) + strlen(*incver) + 2);
+ char *p = new_dir;
+
+ strcpy(new_dir, dir);
+ p += verdir - dir + 1; /* advance to char following '/' in VERSION_DIRECTORY_STRING */
+ memcpy(p, *incver, strlen(*incver)); /* copy incver there instead */
+ p += strlen(*incver); /* advance past version we just copied */
+ strcpy(p, verdir + strlen(VERSION_DIRECTORY_STRING)); /* and copy the rest of the original dir */
+
+ incpush(new_dir, FALSE, FALSE, FALSE);
+ free(new_dir);
+ }
+#endif
+}
+
+
/* Push a directory onto @INC if it exists.
Generate a new SV if we do this, to save needing to copy the SV we push
onto @INC */

12
perl-5.8.8-no_asm_page_h.patch
View File

@ -1,12 +0,0 @@
--- perl-5.8.8/ext/IPC/SysV/SysV.xs.no_asm_page_h 2001-06-30 14:46:07.000000000 -0400
+++ perl-5.8.8/ext/IPC/SysV/SysV.xs 2006-06-02 17:37:22.000000000 -0400
@@ -3,9 +3,6 @@
#include "XSUB.h"
#include <sys/types.h>
-#ifdef __linux__
-# include <asm/page.h>
-#endif
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
#ifndef HAS_SEM
# include <sys/ipc.h>

42
perl-5.8.8-perlbug-tag-A.patch
View File

@ -1,42 +0,0 @@
--- perl-5.8.8-RC1/utils/perlbug.PL.perlbug 2006-01-03 14:07:41.000000000 -0500
+++ perl-5.8.8-RC1/utils/perlbug.PL 2006-01-20 14:33:26.000000000 -0500
@@ -71,7 +71,7 @@
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
-my \$config_tag1 = '$extract_version - $Config{cf_time}';
+my \$config_tag1 = '$extract_version';
my \$patchlevel_date = $patchlevel_date;
my \$patch_tags = '$patch_tags';
@@ -287,18 +287,9 @@
# OK - send "OK" report for build on this system
$ok = 0;
if ($::opt_o) {
- if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
- my $age = time - $patchlevel_date;
- if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
- my $date = localtime $patchlevel_date;
- print <<"EOF";
-"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
-are more than 60 days old. This Perl version was constructed on
-$date. If you really want to report this, use
-"perlbug -okay" or "perlbug -nokay".
-EOF
- exit();
- }
+ #
+ # Red Hat modification: remove -ok / -nok refusal to report due to age
+ #
# force these options
unless ($::opt_n) {
$::opt_S = 1; # don't prompt for send
@@ -605,7 +596,7 @@
print OUT <<EFF;
---
EFF
- print OUT "This perlbug was built using Perl $config_tag1\n",
+ print OUT "This perlbug was built using Perl $config_tag1 in the Red Hat build system.\n",
"It is being executed now by Perl $config_tag2.\n\n"
if $config_tag2 ne $config_tag1;

50
perl-5.8.8-perlbug-tag.patch
View File

@ -1,50 +0,0 @@
--- perl-5.8.8-RC1/utils/perlbug.PL.perlbug 2006-01-03 14:07:41.000000000 -0500
+++ perl-5.8.8-RC1/utils/perlbug.PL 2006-01-31 14:33:47.000000000 -0500
@@ -27,7 +27,6 @@
open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
or die "Can't open patchlevel.h: $!";
-my $patchlevel_date = (stat PATCH_LEVEL)[9];
my $patchnum = "";
while (<PATCH_LEVEL>) {
@@ -71,9 +70,8 @@
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
-my \$config_tag1 = '$extract_version - $Config{cf_time}';
+my \$config_tag1 = '$extract_version';
-my \$patchlevel_date = $patchlevel_date;
my \$patch_tags = '$patch_tags';
my \@patches = (
$patch_desc
@@ -288,17 +286,6 @@
$ok = 0;
if ($::opt_o) {
if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
- my $age = time - $patchlevel_date;
- if ($::opt_o eq 'k' and $age > 60 * 24 * 60 * 60 ) {
- my $date = localtime $patchlevel_date;
- print <<"EOF";
-"perlbug -ok" and "perlbug -nok" do not report on Perl versions which
-are more than 60 days old. This Perl version was constructed on
-$date. If you really want to report this, use
-"perlbug -okay" or "perlbug -nokay".
-EOF
- exit();
- }
# force these options
unless ($::opt_n) {
$::opt_S = 1; # don't prompt for send
@@ -605,8 +592,8 @@
print OUT <<EFF;
---
EFF
- print OUT "This perlbug was built using Perl $config_tag1\n",
- "It is being executed now by Perl $config_tag2.\n\n"
+ print OUT "This perlbug was built using Perl $config_tag1 in the Red Hat build system.\n",
+ "It is being executed now by Perl $config_tag2.\n\n"
if $config_tag2 ne $config_tag1;
print OUT <<EOF;

22
perl-5.8.8-up27133_up27169.patch
View File

@ -1,22 +0,0 @@
--- perl-5.8.8/ext/threads/threads.xs.up27133_up27169 2005-10-16 13:53:32.000000000 -0400
+++ perl-5.8.8/ext/threads/threads.xs 2006-02-13 14:21:47.000000000 -0500
@@ -623,7 +623,7 @@
PerlInterpreter *other_perl = thread->interp;
CLONE_PARAMS clone_params;
clone_params.stashes = newAV();
- clone_params.flags |= CLONEf_JOIN_IN;
+ clone_params.flags = CLONEf_JOIN_IN;
PL_ptr_table = ptr_table_new();
current_thread = Perl_ithread_get(aTHX);
Perl_ithread_set(aTHX_ thread);
--- perl-5.8.8/regcomp.c.up27133_up27169 2006-01-08 15:59:27.000000000 -0500
+++ perl-5.8.8/regcomp.c 2006-02-13 14:23:26.000000000 -0500
@@ -1810,7 +1810,7 @@
r->subbeg = NULL;
r->reganch = pm->op_pmflags & PMf_COMPILETIME;
r->nparens = RExC_npar - 1; /* set early to validate backrefs */
-
+ r->lastparen = 0; /* mg.c reads this. */
r->substrs = 0; /* Useful during FAIL. */
r->startp = 0; /* Useful during FAIL. */
r->endp = 0; /* Useful during FAIL. */

64
perl-5.8.8-up27284.patch
View File

@ -1,64 +0,0 @@
Change 27284 by nicholas@nicholas-saigo on 2006/02/23 14:49:22
Integrate:
[ 27002]
Code assumes that *FOO{SCALAR} will always return a scalar reference,
so make it so, creating $FOO if necessary.
(Effectively this is a policy decision that PERL_DONT_CREATE_GVSV is
visible to XS code, but isn't visible to Perl code)
Affected files ...
... //depot/maint-5.8/perl/pp.c#86 integrate
... //depot/maint-5.8/perl/t/op/gv.t#4 integrate
Differences ...
==== //depot/maint-5.8/perl/pp.c#86 (text) ====
Index: perl/pp.c
--- perl/pp.c#85~26738~ 2006-01-08 13:30:11.000000000 -0800
+++ perl/pp.c 2006-02-23 06:49:22.000000000 -0800
@@ -604,7 +604,7 @@
break;
case 'S':
if (strEQ(second_letter, "CALAR"))
- tmpRef = GvSV(gv);
+ tmpRef = GvSVn(gv);
break;
}
}
==== //depot/maint-5.8/perl/t/op/gv.t#4 (xtext) ====
Index: perl/t/op/gv.t
--- perl/t/op/gv.t#3~25505~ 2005-09-19 15:20:52.000000000 -0700
+++ perl/t/op/gv.t 2006-02-23 06:49:22.000000000 -0800
@@ -12,7 +12,7 @@
use warnings;
require './test.pl';
-plan( tests => 61 );
+plan( tests => 63 );
# type coersion on assignment
$foo = 'foo';
@@ -218,6 +218,19 @@
is ($x, "Rules\n");
}
+
+{
+ no warnings qw(once uninitialized);
+ my $g = \*clatter;
+ my $r = eval {no strict; ${*{$g}{SCALAR}}};
+ is ($@, '', "PERL_DONT_CREATE_GVSV shouldn't affect thingy syntax");
+
+ $g = \*vowm;
+ $r = eval {use strict; ${*{$g}{SCALAR}}};
+ is ($@, '',
+ "PERL_DONT_CREATE_GVSV shouldn't affect thingy syntax under strict");
+}
+
__END__
Perl
Rules
End of Patch.

11
perl-5.8.8-useCFLAGSwithCC.patch
View File

@ -1,11 +0,0 @@
--- perl-5.8.8/Configure.BAD 2006-07-17 12:43:58.000000000 -0400
+++ perl-5.8.8/Configure 2006-07-17 12:44:04.000000000 -0400
@@ -7659,7 +7659,7 @@
'') dflt="$dflt +vnocompatwarnings" ;;
esac
;;
- linux|irix*|gnu*) dflt='-shared' ;;
+ linux|irix*|gnu*) dflt="-shared $optimize" ;;
next) dflt='none' ;;
solaris) dflt='-G' ;;
sunos) dflt='-assert nodefinitions' ;;

10
perl.spec
View File

@ -11,7 +11,7 @@
Name: perl
Version: %{perl_version}
Release: 27%{?dist}
Release: 28%{?dist}
Epoch: %{perl_epoch}
Summary: The Perl programming language
Group: Development/Languages
@ -75,6 +75,9 @@ Patch15: perl-5.10.0-bz448392.patch
# Wrong access test
Patch16: perl-5.10.0-accessXOK.patch
# CVE-2008-2827 perl: insecure use of chmod in rmtree
Patch17: perl-5.10.0-CVE-2008-2827.patch
BuildRoot: %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
BuildRequires: tcsh, dos2unix, man, groff
BuildRequires: gdbm-devel, db4-devel, zlib-devel
@ -798,6 +801,7 @@ upstream tarball from perl.org.
%patch14 -p1
%patch15 -p1
%patch16 -p1
%patch17 -p1
#
# Candidates for doc recoding (need case by case review):
@ -1010,6 +1014,7 @@ perl -x patchlevel.h 'Fedora Patch13: Upgrade Module::CoreList to 2.14'
perl -x patchlevel.h 'Fedora Patch14: Upgrade CGI to 3.37'
perl -x patchlevel.h 'Fedora Patch15: Adopt upstream commit for assertion'
perl -x patchlevel.h 'Fedora Patch16: Access permission - rt49003'
perl -x patchlevel.h 'Fedora Patch17: CVE-2008-2827 perl: insecure use of chmod in rmtree'
%clean
rm -rf $RPM_BUILD_ROOT
@ -1615,6 +1620,9 @@ make test
# Old changelog entries are preserved in CVS.
%changelog
* Tue Jun 24 2008 Marcela Maslanova <mmaslano@redhat.com> 4:5.10.0-28
- CVE-2008-2827 perl: insecure use of chmod in rmtree
* Wed Jun 11 2008 Marcela Maslanova <mmaslano@redhat.com> 4:5.10.0-27
- 447371 wrong access permission rt49003