Swapping UID and EUID fails in perl scripts

[David I]

Binary package hint: perl-base

The following perl (from perl-base) script fails in the new LTS Ubuntu 10.04, it works in LTS version 8.04.

It tests the perl statement

    ($>, $<) = ($<, $>)

which is documented in perl's perlvar maunal page.

The output expected is in the scripts header comments.

Under Ubuntu 10.04 it results in:

Testing perl version 5.010001
Initially UID = 1000, EUID = 1001
After swap UID = 1001, EUID = 1001
EUID (1001) should be 1000 at /tmp/swap_uid.pl line 16.
ERROR: Test failed.

Notice how the 2 uids are the same after the attempt to swap.

<b>Note to demonstrate this bug the script needs to perform sudo commands.</b> Therefore
  1) check the script first for unsafe behaviour
  2) to run it you will be prompted fro your sudo password. Don't run it if you don't have sudo rights

Notes:
1) In the early days of Ubuntu 8.04 there was a similar problem that was fixed at some time.
2) I've now also tested Ubuntu 9.10 (with perl 5.10.0) and it has the same bug.
3) There is possibly a security issue here as a script that assumes that it has swapped the UIDs back will actually be running under a different UID than intended. However this is too slight to mark it as a security bug. Please feel free to escalate if you feel differently.
4) This script does not use the suid-perl package that is now deprecated - it is a bug in the core perl program.

Kind regards,
David.

<---begin script--->
#!/usr/bin/perl

# this program should give output like:
#
# Testing perl version 5.008008
# Initially UID = 1020, EUID = 1021
# After swap UID = 1021, EUID = 1020
# After double swap UID = 1020, EUID = 1021
#

use warnings;
use strict;

# This program creates a perl_script:

my $perl_script = "/tmp/swap_uid.pl";

# and a C program that runs this perl script:

my $c_source = "/tmp/run_me.c";
my $c_program = "/tmp/run_me";

# This program is given a different owner ID

my $other_uid = $< + 1;

sub my_system($)
{
    my $command = shift;
    my $result = system $command;
    $result /= 256;

    return $result;
}

sub create_perl_script($)
{
    my $file_name = shift;

    my $script = '#!/usr/bin/perl

use warnings;
use strict;

my $real_uid = $<;
my $eff_uid = $>;

die "Effective UID ($eff_uid) is same as own UID" if ($real_uid == $eff_uid);
print "Testing perl version $]\n";
print "Initially UID = $<, EUID = $>\n";
($<, $>) = ($>, $<);
print "After swap UID = $<, EUID = $>\n";
die "Effective UID ($eff_uid) is same as own UID" if ($real_uid == $eff_uid);
die "UID ($<) should be $eff_uid" if ($< != $eff_uid);
die "EUID ($>) should be $real_uid" if ($> != $real_uid);
($<, $>) = ($>, $<);
print "After double swap UID = $<, EUID = $>\n";
die "Effective UID ($eff_uid) is same as own UID" if ($real_uid == $eff_uid);
die "UID ($<) should be $real_uid" if ($< != $real_uid);
die "EUID ($>) should be $eff_uid" if ($> != $eff_uid);
exit 0;
';

    open my $FH, '>', $file_name or die "Could not open script file";
    print $FH $script or die "Could not print script file";
    close $FH or die "Could not close script file";
    my_system "sudo chmod ug+rx $file_name" and die "Could not set suid bit of program";
}

sub create_program($$$$)
{
    my $source_file = shift;
    my $executable = shift;
    my $exec_owner = shift;
    my $script = shift;

    # See perlsec where this code is presented.
    my $source = '#define REAL_PATH "'. $script . '"
                  main(int ac, char **av)
                  {
                      execv(REAL_PATH, av);
                  }
';

    open my $FH, '>', $source_file or die "Could not open source file";
    print $FH $source or die "Could not print source file";
    close $FH or die "Could not close source file";

    my_system "gcc -o $executable $source_file" and die "Could not compile C program";
    my_system "sudo chown $exec_owner $executable" and die "Could not change ownership of program";
    my_system "sudo chmod ug+s $executable" and die "Could not set suid bit of program";
}

sub run_test($)
{
    my $executable = shift;
    my_system("$executable") and print "ERROR: Test failed.\n";
}

sub cleanup
{

    foreach my $f (@_)
    {
        system "sudo chown $< $f";
        unlink $f;
    }
}

create_perl_script($perl_script);
create_program($c_source, $c_program, $other_uid, $perl_script);
run_test($c_program);
cleanup($c_source, $c_program, $perl_script);

[David I (david-ingamells)]

The following code change fixes the problem with perl 5.10 .1. The above script now gives this output:

Testing perl version 5.010001
Initially UID = 1020, EUID = 1021

After swap UID = 1021, EUID = 1020

After double swap UID = 1020, EUID = 1021

PLEASE FIX THE DISTRIBUTED VERSION IN UBUNTU 10.4.

In mg.c use setresuid by preference if it is available and set the saved uid (3rd argument) to the other value so that both values (real and effective) are always present among the 3 values the system knows (real, effective and saved).

    case '<':
  PL_uid = SvIV(sv);
  if (PL_delaymagic)
  {
   PL_delaymagic |= DM_RUID;
   break; /* don't do magic till later */
  }

#ifdef HAS_SETRESUID
  {
   Uid_t Curr_uid = getuid();
   Uid_t Curr_euid = geteuid();
   Uid_t saved_Uid = (Curr_uid != (Uid_t)PL_uid) ? Curr_uid : Curr_euid;
   (void)setresuid((Uid_t)PL_uid, (Uid_t)-1, saved_Uid);
  }
#else
#ifdef HAS_SETRUID
  (void)setruid((Uid_t)PL_uid);
#else
#ifdef HAS_SETREUID
  (void)setreuid((Uid_t)PL_uid, (Uid_t)-1);
#else
  if (PL_uid == PL_euid)
  { /* special case $< = $> */
#ifdef PERL_DARWIN
     /* workaround for Darwin's setuid peculiarity, cf [perl #24122] */
   if (PL_uid != 0 && PerlProc_getuid() == 0)
   {
    (void)PerlProc_setuid(0);
   }
#endif
   (void)PerlProc_setuid(PL_uid);
  }
  else
  {
   PL_uid = PerlProc_getuid();
   Perl_croak(aTHX_ "setruid() not implemented");
  }
#endif
#endif
#endif
  PL_uid = PerlProc_getuid();
  PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
  break;
    case '>':
  PL_euid = SvIV(sv);
  if (PL_delaymagic)
  {
   PL_delaymagic |= DM_EUID;
   break; /* don't do magic till later */
  }
#ifdef HAS_SETRESUID
  {
   Uid_t Curr_uid = getuid();
   Uid_t Curr_euid = geteuid();
   Uid_t saved_Uid = (Curr_euid != (Uid_t)PL_euid) ? Curr_euid : Curr_uid;
   (void)setresuid((Uid_t)-1, (Uid_t)PL_euid, saved_Uid);
  }
#else
#ifdef HAS_SETEUID
  (void)seteuid((Uid_t)PL_euid);
#else
#ifdef HAS_SETREUID
  (void)setreuid((Uid_t)-1, (Uid_t)PL_euid);
#else
  if (PL_euid == PL_uid) /* special case $> = $< */
  {
   PerlProc_setuid(PL_euid);
  }
  else
  {
   PL_euid = PerlProc_geteuid();
   Perl_croak(aTHX_ "seteuid() not implemented");
  }
#endif
#endif
#endif