Front page | perl.perl5.porters |
Postings from February 2000
Re: [PATCH] myriad bugs in std modules, w/ security problems
From:
Gurusamy Sarathy
Date:
February 27, 2000 16:07
Subject:
Re: [PATCH] myriad bugs in std modules, w/ security problems
Message ID:
200002280010.QAA28648@maul.activestate.com
On Sun, 27 Feb 2000 14:42:27 MST, Tom Christiansen wrote:
> If you find a "^" to mean "start of string", the pattern must
> also end in /s, or the "^" altered to a "\A".
I don't think this is strictly needed. Doesn't "^" always means beginning
of string, unless /m is specified?
I went and fixed up File::Find for this bug just now. Volunteers for
fixing the others deperately needed. If you have spare tuits, please
speak up.
Sarathy
gsar@ActiveState.com
-----------------------------------8<-----------------------------------
Change 5296 by gsar@auger on 2000/02/28 00:00:05
m/.*$/ etc should be m/.*\z/s in many file handling modules; fix
these insidious errors in File::Basename, File::Find and find2perl
(from Tom Christiansen)
TODO: many other modules need to be fixed as well!
Affected files ...
... //depot/perl/lib/File/Basename.pm#14 edit
... //depot/perl/lib/File/Find.pm#22 edit
... //depot/perl/x2p/find2perl.PL#11 edit
Differences ...
==== //depot/perl/lib/File/Basename.pm#14 (text) ====
Index: perl/lib/File/Basename.pm
--- perl/lib/File/Basename.pm.~1~ Sun Feb 27 16:00:10 2000
+++ perl/lib/File/Basename.pm Sun Feb 27 16:00:10 2000
@@ -37,10 +37,10 @@
"VMS", "MSDOS", "MacOS", "AmigaOS" or "MSWin32", the file specification
syntax of that operating system is used in future calls to
fileparse(), basename(), and dirname(). If it contains none of
-these substrings, UNIX syntax is used. This pattern matching is
+these substrings, Unix syntax is used. This pattern matching is
case-insensitive. If you've selected VMS syntax, and the file
specification you pass to one of these routines contains a "/",
-they assume you are using UNIX emulation and apply the UNIX syntax
+they assume you are using Unix emulation and apply the Unix syntax
rules instead, for that function call only.
If the argument passed to it contains one of the substrings "VMS",
@@ -73,7 +73,7 @@
=head1 EXAMPLES
-Using UNIX file syntax:
+Using Unix file syntax:
($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
'\.book\d+');
@@ -102,7 +102,7 @@
The basename() routine returns the first element of the list produced
by calling fileparse() with the same arguments, except that it always
quotes metacharacters in the given suffixes. It is provided for
-programmer compatibility with the UNIX shell command basename(1).
+programmer compatibility with the Unix shell command basename(1).
=item C<dirname>
@@ -111,8 +111,8 @@
second element of the list produced by calling fileparse() with the same
input file specification. (Under VMS, if there is no directory information
in the input file specification, then the current default device and
-directory are returned.) When using UNIX or MSDOS syntax, the return
-value conforms to the behavior of the UNIX shell command dirname(1). This
+directory are returned.) When using Unix or MSDOS syntax, the return
+value conforms to the behavior of the Unix shell command dirname(1). This
is usually the same as the behavior of fileparse(), but differs in some
cases. For example, for the input file specification F<lib/>, fileparse()
considers the directory name to be F<lib/>, while dirname() considers the
@@ -172,23 +172,23 @@
if ($fstype =~ /^VMS/i) {
if ($fullname =~ m#/#) { $fstype = '' } # We're doing Unix emulation
else {
- ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/);
+ ($dirpath,$basename) = ($fullname =~ /^(.*[:>\]])?(.*)/s);
$dirpath ||= ''; # should always be defined
}
}
if ($fstype =~ /^MS(DOS|Win32)/i) {
- ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/);
- $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/;
+ ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/s);
+ $dirpath .= '.\\' unless $dirpath =~ /[\\\/]\z/;
}
- elsif ($fstype =~ /^MacOS/i) {
- ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/);
+ elsif ($fstype =~ /^MacOS/si) {
+ ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/s);
}
elsif ($fstype =~ /^AmigaOS/i) {
- ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/);
+ ($dirpath,$basename) = ($fullname =~ /(.*[:\/])?(.*)/s);
$dirpath = './' unless $dirpath;
}
elsif ($fstype !~ /^VMS/i) { # default to Unix
- ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#);
+ ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);
if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) {
# dev:[000000] is top of VMS tree, similar to Unix '/'
($basename,$dirpath) = ('',$fullname);
@@ -200,7 +200,7 @@
$tail = '';
foreach $suffix (@suffices) {
my $pat = ($igncase ? '(?i)' : '') . "($suffix)\$";
- if ($basename =~ s/$pat//) {
+ if ($basename =~ s/$pat//s) {
$taint .= substr($suffix,0,0);
$tail = $1 . $tail;
}
@@ -238,30 +238,30 @@
}
if ($fstype =~ /MacOS/i) { return $dirname }
elsif ($fstype =~ /MSDOS/i) {
- $dirname =~ s/([^:])[\\\/]*$/$1/;
+ $dirname =~ s/([^:])[\\\/]*\z/$1/;
unless( length($basename) ) {
($basename,$dirname) = fileparse $dirname;
- $dirname =~ s/([^:])[\\\/]*$/$1/;
+ $dirname =~ s/([^:])[\\\/]*\z/$1/;
}
}
elsif ($fstype =~ /MSWin32/i) {
- $dirname =~ s/([^:])[\\\/]*$/$1/;
+ $dirname =~ s/([^:])[\\\/]*\z/$1/;
unless( length($basename) ) {
($basename,$dirname) = fileparse $dirname;
- $dirname =~ s/([^:])[\\\/]*$/$1/;
+ $dirname =~ s/([^:])[\\\/]*\z/$1/;
}
}
elsif ($fstype =~ /AmigaOS/i) {
- if ( $dirname =~ /:$/) { return $dirname }
+ if ( $dirname =~ /:\z/) { return $dirname }
chop $dirname;
- $dirname =~ s#[^:/]+$## unless length($basename);
+ $dirname =~ s#[^:/]+\z## unless length($basename);
}
else {
- $dirname =~ s:(.)/*$:$1:;
+ $dirname =~ s:(.)/*\z:$1:s;
unless( length($basename) ) {
local($File::Basename::Fileparse_fstype) = $fstype;
($basename,$dirname) = fileparse $dirname;
- $dirname =~ s:(.)/*$:$1:;
+ $dirname =~ s:(.)/*\z:$1:s;
}
}
==== //depot/perl/lib/File/Find.pm#22 (text) ====
Index: perl/lib/File/Find.pm
--- perl/lib/File/Find.pm.~1~ Sun Feb 27 16:00:10 2000
+++ perl/lib/File/Find.pm Sun Feb 27 16:00:10 2000
@@ -135,7 +135,7 @@
produces something like:
sub wanted {
- /^\.nfs.*$/ &&
+ /^\.nfs.*\z/s &&
(($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
int(-M _) > 7 &&
unlink($_)
@@ -306,7 +306,7 @@
Proc_Top_Item:
foreach my $TOP (@_) {
my $top_item = $TOP;
- $top_item =~ s|/$|| unless $top_item eq '/';
+ $top_item =~ s|/\z|| unless $top_item eq '/';
$Is_Dir= 0;
($topdev,$topino,$topmode,$topnlink) = stat $top_item;
@@ -338,7 +338,7 @@
next Proc_Top_Item;
}
if (-d _) {
- $top_item =~ s/\.dir$// if $Is_VMS;
+ $top_item =~ s/\.dir\z// if $Is_VMS;
_find_dir($wanted, $top_item, $topnlink);
$Is_Dir= 1;
}
@@ -466,7 +466,7 @@
if ($nlink == 2 && !$avoid_nlink) {
# This dir has no subdirectories.
for my $FN (@filenames) {
- next if $FN =~ /^\.{1,2}$/;
+ next if $FN =~ /^\.{1,2}\z/;
$name = $dir_pref . $FN;
$_ = ($no_chdir ? $name : $FN);
@@ -479,7 +479,7 @@
$subcount = $nlink - 2;
for my $FN (@filenames) {
- next if $FN =~ /^\.{1,2}$/;
+ next if $FN =~ /^\.{1,2}\z/;
if ($subcount > 0 || $avoid_nlink) {
# Seen all the subdirs?
# check for directoriness.
@@ -488,7 +488,7 @@
if (-d _) {
--$subcount;
- $FN =~ s/\.dir$// if $Is_VMS;
+ $FN =~ s/\.dir\z// if $Is_VMS;
push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
}
else {
@@ -609,7 +609,7 @@
closedir(DIR);
for my $FN (@filenames) {
- next if $FN =~ /^\.{1,2}$/;
+ next if $FN =~ /^\.{1,2}\z/;
# follow symbolic links / do an lstat
$new_loc = Follow_SymLink($loc_pref.$FN);
==== //depot/perl/x2p/find2perl.PL#11 (text) ====
Index: perl/x2p/find2perl.PL
--- perl/x2p/find2perl.PL.~1~ Sun Feb 27 16:00:10 2000
+++ perl/x2p/find2perl.PL Sun Feb 27 16:00:10 2000
@@ -90,7 +90,7 @@
$out .= &tab . "!";
next;
} elsif ($_ eq 'name') {
- $out .= &tab . '/' . &fileglob_to_re(shift) . "/";
+ $out .= &tab . '/' . &fileglob_to_re(shift) . "/s";
} elsif ($_ eq 'perm') {
my $onum = shift;
$onum =~ /^-?[0-7]+$/
@@ -139,9 +139,9 @@
} elsif ($_ eq 'size') {
$_ = shift;
my $n = 'int(((-s _) + 511) / 512)';
- if (s/c$//) {
+ if (s/c\z//) {
$n = 'int(-s _)';
- } elsif (s/k$//) {
+ } elsif (s/k\z//) {
$n = 'int(((-s _) + 1023) / 1024)';
}
$out .= &tab . &n($n, $_);
@@ -215,7 +215,7 @@
$initfile .= "open($fh, " . "e('> ' . $file) .
qq{) || die "Can't open $fh: \$!\\n";\n};
$init{tar} = 1;
- } elsif (/^(n?)cpio$/) {
+ } elsif (/^(n?)cpio\z/) {
die "-$_ must have a filename argument\n" unless @ARGV;
my $file = shift;
my $fh = 'FH' . $file;
@@ -662,7 +662,7 @@
my $x = shift;
$x =~ s#([./^\$()])#\\$1#g;
$x =~ s#([?*])#.$1#g;
- "^$x\$";
+ "^$x\\z";
}
sub n {
End of Patch.