Front page | perl.perl5.porters |
Postings from February 2000
[PATCH] myriad bugs in std modules, w/ security problems
Thread Previous
|
Thread Next
From:
Tom Christiansen
Date:
February 27, 2000 13:43
Subject:
[PATCH] myriad bugs in std modules, w/ security problems
Message ID:
1920.951687747@chthon
I just looked in various standard libraries, and was fairly traumatized
by seeing how many are making some very improper, and very dangerous,
assumptions about the constitution of filenames and the behavior of
regular expressions.
Watch:
------------
./perl -Ilib -MFile::Basename -e 'printf "file=<%s>, dir=<%s>\n", fileparse("foo/bar\n")'
file=<bar>, dir=<foo/>
./perl -I/tmp/fixbase -Ilib -MFile::Basename -e 'printf "file=<%s>, dir=<%s>\n", fileparse("foo/bar\n")'
file=<bar
>, dir=<foo/>
------------
./perl -Ilib -MFile::Basename -e 'printf "file=<%s>, dir=<%s>\n", fileparse("\nfoo/bar")'
file=<>, dir=<./>
./perl -I/tmp/fixbase -Ilib -MFile::Basename -e 'printf "file=<%s>, dir=<%s>\n", fileparse("\nfoo/bar")'
file=<bar>, dir=<
foo/>
------------
./perl -Ilib -MFile::Basename -e 'printf "file=<%s>, dir=<%s>\n", fileparse("foo\n/bar")'
file=<foo>, dir=<./>
./perl -I/tmp/fixbase -Ilib -MFile::Basename -e 'printf "file=<%s>, dir=<%s>\n", fileparse("foo\n/bar")'
file=<bar>, dir=<foo
/>
------------
./perl -Ilib -MFile::Basename -e 'printf "file=<%s>, dir=<%s>\n", fileparse("foo\n/bar\n")'
file=<foo>, dir=<./>
./perl -I/tmp/fixbase -Ilib -MFile::Basename -e 'printf "file=<%s>, dir=<%s>\n", fileparse("foo\n/bar\n")'
file=<bar
>, dir=<foo
/>
------------
See the problem? Here's a patch for File::Basename, but there are
many more to go. Anywhere that a pattern is applied to a filename,
the pattern must be closely inspected, and the following measures
taken:
If you find a "." to mean "any character", the pattern must end
in /s.
If you find a "^" to mean "start of string", the pattern must
also end in /s, or the "^" altered to a "\A".
If you find a "$" to mean "end of string", the "$" altered to
a "\z". Not "\Z", but "\z".
In fact, it might be a good idea to just put /s on everything, but
you still have the \z issue.
These many errors in many files will, at the very least, lead to
incorrect behavior. In some cases, these bugs lead directly to
insidious security holes. Consider this example of bad code,
directly out of the File::Find module:
next if $FN =~ /^\.{1,2}$/;
Watch this closely:
$ mkdir /tmp/testdir
$ perl -e 'mkdir("/tmp/testdir/..\n", 0777) or die $!'
$ perl -e 'mkdir("/tmp/testdir/..\n/etc", 0777) or die $!'
$ perl -e 'open(FH, ">/tmp/testdir/..\n/etc/passwd") or die $! '
$ find /tmp/testdir/ -print
/tmp/testdir/
/tmp/testdir/..
/tmp/testdir/..
/etc
/tmp/testdir/..
/etc/passwd
$ perl -MFile::Find -le 'find (sub{print STDOUT $File::Find::name}, "/tmp/testdir")'
/tmp/testdir
/tmp/testdir/..
/tmp/testdir/..
/.font-unix
/tmp/testdir/..
/.font-unix/fs-1
/tmp/testdir/..
/SECUR-A
/tmp/testdir/..
/x
/tmp/testdir/..
/testdir
/tmp/testdir/..
/ss.sh
/tmp/testdir/..
/.ICE-unix
/tmp/testdir/..
/ss.pl
/tmp/testdir/..
/.X11-unix
/tmp/testdir/..
/orbit-root
/tmp/testdir/..
/.esd
/tmp/testdir/..
/tksysv-backup
/tmp/testdir/..
/orbit-tchrist
/tmp/testdir/..
/kio_502_1498turquoise_0.0
/tmp/testdir/..
/kio_502_1716turquoise_0.0
/tmp/testdir/..
/kfm_502_1716turquoise_0.0
/tmp/testdir/..
/kio_502_21179turquoise_0.0
/tmp/testdir/..
/kfm_502_21179turquoise_0.0
/tmp/testdir/..
/.X0-lock
/tmp/testdir/..
/kio_502_7514turquoise_0.0
/tmp/testdir/..
/kfm_502_7514turquoise_0.0
This is *seriously* bad. Not only did the perl version miss the
stuff hidden in "..\n" directory, it proceeded to run back up the
tree!
Here's File::Basename. I've got to back to some other stuff now.
There's a lot to be fixed. The standard Perl libraries need to all
be subjected to a complete code inspection for these issues.
--tom
--- /usr/local/src/perl5.5.650/lib/File/Basename.pm Sun Jan 23 04:58:30 2000
+++ /tmp/fixbase/File/Basename.pm Sun Feb 27 14:09:08 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;
}
}
Thread Previous
|
Thread Next