*BSD News Article 91661


Return to BSD News archive

Path: euryale.cc.adfa.oz.au!newshost.carno.net.au!harbinger.cc.monash.edu.au!news.cs.su.oz.au!metro!metro!usyd.edu.au!nobody
From: nobody@usyd.edu.au (Paul Szabo)
Newsgroups: comp.security.unix,comp.unix.bsd.freebsd.misc
Subject: Re: Why is cleaning /tmp with find a security problem?
Date: 20 Mar 1997 10:03:34 GMT
Organization: Mathematics, University of Sydney
Lines: 424
Sender: psz-at-maths-dot-usyd-dot-edu-dot-au (Paul Szabo)
Distribution: world
Message-ID: <5gr21m$brn@metro.usyd.edu.au>
References: <5gq5q6$cst@mozo.cc.purdue.edu>
Reply-To: psz-at-maths-dot-usyd-dot-edu-dot-au (Paul Szabo)
NNTP-Posting-Host: adder.maths.su.oz.au
Xref: euryale.cc.adfa.oz.au comp.security.unix:32863 comp.unix.bsd.freebsd.misc:37548

In article <5gq5q6$cst@mozo.cc.purdue.edu> ajk@schwinger.physics.purdue.edu 
(Andrew J. Korty) writes:
> From the stock /etc/daily distributed with FreeBSD:
> # This is a security hole, never use 'find' on a public directory
> # with -exec rm -f as root.  This can be exploited to delete any file
> # on the system.
> Why?  ... Am I missing something obvious?

The perl program below is more-or-less what I use to clean up /tmp and the 
like. The comments within answer your question.
---
[ The email address is munged in the headers and in the lines below, in an ]
[ attempt to avoid junk (spam) mail. Sorry about the inconvenience caused. ]
---
Paul Szabo - System Manager     //      School of Mathematics and Statistics
psz at maths . usyd . edu . au //  University of Sydney, NSW 2006, Australia

---
#! /usr/local/bin/perl --
#
#V  cleantmp V1.1  24 Jun 96  Paul Szabo
#
#   Clean /tmp-type directories, replacing commands like
#   find /tmp -type f -atime +2 -exec rm {} \;
#
#   This program, with slight changes noted below, could be used as a
#   safe-rm command to replace rm, e.g. to be used in find commands
#   as above. (But replacing the find with cleantmp is better.)
#
#   # There is a race between when find starts to descend into /tmp and when it
#   # calls rm. Suppose I make deeply nested  trees like
#   #
#   #   /tmp/a/b/c/d/passwd         (all real dirs and file) and also
#   #   /tmp/x/b/c/d -> /etc        (all real dirs and the last symlink)
#   #
#   # then, after find starts up but before it reaches /tmp/a/.../passwd I do
#   #
#   #   cd /tmp; mv a z; mv x a
#   #
#   # then find will exec 'rm /tmp/a/b/c/d/passwd' but this removes /etc/passwd.
#   # If the directories are deep enough then find will slow down a lot, and the
#   # race will be easy to win.
#
#   We increase security in two ways:
#   1) ensure that we get a current, full path without any symlinks
#   2) change UID to owner of the file and refuse objects owned by root


$TOP = '/';
if ( -d '/usr/apollo' ) { $APOLLO = 1; $TOP = '//'; }


( $CMD = $0 ) =~ s!^/?([^/]*/)*!!;


sub err {
  if ("$USAGE" ne '') {
    if ($#_ >= 0) { print "$CMD failed with error:\n\n"; }
    else          { print "$CMD failed with some unknown error.\n"; }
  }
  foreach (@_) { print "$_\n"; }
  if ("$USAGE" ne '') { print "\nUsage:$USAGE"; }
  exit 1;
}


# Returns success or failure whether path given is acceptable
sub goodpath {
  my ($path) = @_;
  if ( length($path) < 1 || length($path) > 999 ) { return 0; }
  if ( $path =~ m![^a-zA-Z0-9.\!/,:_-]! ) { return 0; }
  if ( $path =~ m!^[^a-zA-Z0-9.\!/]! ) { return 0; }
  if ( $APOLLO ) { if ( $path =~ m!/[^a-zA-Z0-9.\!/]! ) { return 0; }; if ( $path =~ m!.//! ) { return 0; } }
  else           { if ( $path =~ m!/[^a-zA-Z0-9.\!]! ) { return 0; } }
  if ( $path =~ m![^/]/$! ) { return 0; }
  return 1;
}


# Returns full (absolute) path beginning with /, or error message.
sub fullpath {
  # Whinge: Why is this not part of standard Perl?
  # Or at least why is getwd not implemented?

  my ($path) = @_;
  my ($obj, $dir, $nam, $name, $loop, @statp, @statt, @statd, @stato);

  goodpath($path) || return "Bad pathname $path .";
  @statp = stat("$path"); $#statp = 1;
  if ( ! -e _ ) { return "Object $path does not exist"; }

  $obj = "$path";

  if ( $obj =~ m![^/]/$! ) { $obj =~ s!/$!!; }
  ( $dir = "$obj" ) =~ s![^/]*$!!;
  ( $nam = "$obj" ) =~ s!^.*/!!;
  if ( "$obj" ne "$dir$nam" ) { return "Cannot decompose object name $obj: $dir and $nam ?"; }

  lstat("$obj");

  $loop = 0;
  while ( -l _ ) {
    $loop++;
    if ( $loop > 20 ) { return "Symlink loop in $obj"; }
    $nam = readlink("$obj");
    if ("$nam" eq '') { return "Cannot resolve link $obj: $!"; }
    if ("$nam" =~ m!^/!) { $obj = "$nam"; }
    else                 { $obj = "$dir$nam"; }
    goodpath($obj) || return "Bad object name $obj .";
    ( $dir = "$obj" ) =~ s![^/]*$!!;
    ( $nam = "$obj" ) =~ s!^.*/!!;
    if ( "$obj" ne "$dir$nam" ) { return "Cannot decompose object name $obj: $dir and $nam ?"; }

    @stato = stat("$obj"); $#stato = 1;
    if ( "@statp" ne "@stato" ) { return "Cannot resolve $path: not same as $obj ?"; }
    lstat("$obj");
  }

  if ( "$nam" eq '.' || "$nam" eq '..' ) { $dir = "$dir$nam"; $nam = ''; }

  @statt = stat("$TOP"); $#statt = 1;
  if ( ! -d _ ) { return "But $TOP is not a directory ?"; }

  if ("$dir" eq '') { $dir = '.'; }
  if ( $dir =~ m![^/]/$! ) { $dir =~ s!/$!!; }

  @statd = stat("$dir"); $#statd = 1;

  $loop = 0;
  while ( "@statd" ne "@statt" ) {
    if ( $loop > 100 ) { return "Directory loop in $obj"; }
    if ( ! -d _ ) { return "But $dir is not a directory ?"; }
    opendir (DH,"$dir/..") || return "Cannot read directory $dir/.. ?";
    @stato = ();
    while ( "@statd" ne "@stato" ) {
      $name = readdir(DH) || last;
      if ( "$name" eq '.' || "$name" eq '..' ) { next; }
      if ( $name =~ m!/! ) { next; }
      goodpath("$name") || next;
      goodpath("$dir/../$name") || next;
      @stato = lstat("$dir/../$name"); $#stato = 1;
    }
    closedir (DH) || return "Cannot stop reading directory $dir/.. ?";
    if ( "@statd" ne "@stato" ) { return "Cannot look up $dir (for $dir/$nam) in $dir/.. ?"; }
    $dir = "$dir/..";
    if ( "$nam" eq '' ) { $nam = "$name"; }
    else                { $nam = "$name/$nam"; }
    goodpath($nam) || return "Bad name $dir/$nam .";
    @statd = stat("$dir"); $#statd = 1;
    if ( "@statd" eq "@stato" ) { last; }
  }

  $obj = "$TOP$nam";
  goodpath($obj) || return "Bad final pathname $obj";

  @stato = stat("$obj"); $#stato = 1;
  if ( "@statp" ne "@stato" ) { return "Cannot resolve $path: not same as $obj ?"; }

  return "$obj";
}


# Returns error message or full (absolute) path beginning with /
# for directory, keeping last leaf as is. Same as fullpath except
# for symlinks: fullpath returns the object pointed to, or
# whinges if it points nowhere.
sub fulldir {
  my ($path) = @_;
  my ($obj, $dir, $nam, @statp, @stato);

  goodpath($path) || return "Bad pathname $path .";
  @statp = lstat("$path"); $#statp = 1;
  if ( ! -l _ ) { return fullpath("$path"); }

  $obj = "$path";

  if ( $obj =~ m![^/]/$! ) { $obj =~ s!/$!!; }
  ( $dir = "$obj" ) =~ s![^/]*$!!;
  ( $nam = "$obj" ) =~ s!^.*/!!;
  if ( "$obj" ne "$dir$nam" ) { return "Cannot decompose object name $obj: $dir and $nam ?"; }
  if ( "$nam" eq '' || "$nam" eq '.' || "$nam" eq '..' ) { return "Bad linkname $path"; }

  if ("$dir" eq '') { $dir = '.'; }
  if ( $dir =~ m![^/]/$! ) { $dir =~ s!/$!!; }

  $obj = fullpath("$dir");
  if ( $obj !~ m!^/! ) { return "$obj"; }

  if ( $obj =~ m!/$! ) { $obj = "$obj$nam"; }
  else                 { $obj = "$obj/$nam"; }

  goodpath($obj) || return "Bad final pathname $obj";

  @stato = lstat("$obj"); $#stato = 1;
  if ( "@statp" ne "@stato" ) { return "Cannot resolve $path: not same as $obj ?"; }

  return "$obj";
}


# This routine DOES NOT RETURN !!
# Removes object $file.
# If $statted is 1, then lstat($file) must still be available as lstat(_).
# (This allows an extra degree of checking that we remove the right object.)
# This routine does not return, mainly because it sets UID, GID to 'owner'
# of the file to remove, and can never set it back. (This protects somewhat
# against being tricked and removing the wrong file.)
# To remove multiple files, use saferm_fork instead.
sub saferm {
  my ($file, $statted) = @_;
  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
  my ($nam, $dir, $n, $dgid, @statl, @statn);

  goodpath($file) || err ("Bad object name $file .");
  if ( $statted == 1 ) {
    @statn = lstat(_);
    @statl = lstat("$file");
    if ( "@statl" ne "@statn" ) { err ("Object $file seems to have changed"); }
  }
  else {
    @statl = lstat("$file");
  }
  if ( ! -e _ ) { err ("Object $file does not exist."); }
  if ( ! ( -f _ || -d _ || -l _ || -p _ || -S _) ) { err ("Object $file is not a (plain) file, directory, symlink, pipe or socket."); }

  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = @statl;

  # Files created often inherit group from directory.
  # Check later that the GID matches that of the directory,
  # set some safe GID for now.
  $dgid = $gid;
  if ( $gid < 99 ) { $gid = 99; }
  if ( $uid < 99 || $uid > 32000 ) { err ("Object $file is owned by UID $uid"); }
  if ( $gid < 99 || $gid > 32000 ) { err ("Object $file is owned by GID $gid"); }
  # Give up privileges
  $( = $gid; $) = $gid; $< = $uid; $> = $uid;
  if ( $< != $uid || $> != $uid || $( != $gid || $) != $gid ) { err ("Object $file: cannot set UID $uid, GID $gid"); }

  $n = fulldir("$file");
  if ( $n !~ m!^/! ) { err ("Error resolving $file: $n"); }
  if ( "$n" ne "$file" ) { err ("Not full pathname $file: it really is $n"); }

  ( $dir = "$file" ) =~ s![^/]*$!!;
  ( $nam = "$file" ) =~ s!^.*/!!;
  if ( "$file" ne "$dir$nam" ) { err ("Cannot decompose object name $file: $dir and $nam ?"); }
  if ( "$nam" eq '' || "$nam" eq '.' || "$nam" eq '..' || "$dir" eq '' ) { err ("Bad object name $file"); }

  if ( $dir =~ m![^/]/$! ) { $dir =~ s!/$!!; }

  chdir("$TOP") || err ("Object $file: Cannot chdir($TOP)");
  $n = fullpath('.');
  if ( "$n" ne "$TOP" ) { err ("Object $file: chdir($TOP) got us to $n"); }
  chdir("$dir") || err ("Object $file: Cannot chdir($dir)");
  $n = fullpath('.');
  if ( "$n" ne "$dir" ) { err ("Object $file: chdir($dir) got us to $n"); }

  if ( $dgid < 99 ) {
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = lstat('.');
    if ( $gid != $dgid ) { err ("Object $file is owned by GID $gid, though directory is owned by $dgid"); }
  }

  @statn = lstat("$nam");
  if ( "@statl" ne "@statn" ) { err ("Object $file seems to have changed"); }

  if ( -d _ ) {
    # print "About to rmdir $file ...\n";
    rmdir("$nam"); # || err ("Cannot remove dir $file");
    # No error message: it may have been not empty
  }
  else {
    # print "About to unlink $file ...\n";
    unlink("$nam") || err ("Cannot remove $file");
  }
  exit 0;
}


#   If we wanted safe-rm only, then here we should have something like:
#
# if ( $#ARGV != 0 ) { err ("Specify one object (only) to remove."); }
# ($FILE) = @ARGV;
# saferm ($FILE, 0);
# __END__
#
#   and throw the rest of the stuff away.


# Uses saferm after forking.
# Same arguments as saferm.
sub saferm_fork {
  my ($file, $statted) = @_;
  my ($pid);

  if ( ! defined($pid = fork) ) { print "Cannot fork to remove $file\n"; }
  if ( $pid == 0 ) {
    saferm ($file, $statted);
    exit 0;
  }
  waitpid($pid,0);
}


sub recurse {
  my ($CWD, $DIR) = @_;
  my ($NEW);
  my (@statc, @statn, @stato);
  my ($nam, $NEWD, @dlist);

  if ( "$CWD" ne '' ) {
    if ( ! goodpath($CWD) ) { print "Bad current directory $CWD\n"; return; }
    @statc = lstat("."); $#statc = 1;
    if ( ! -d _ ) { err ("Current directory $CWD is not a directory ??"); }
    @stato = lstat($CWD); $#stato = 1;
    if ( "@statc" ne "@stato" ) { print "Current directory $CWD different from '.' ??\n"; return; }
    if ( $CWD =~ m!/$! ) { $NEW = "$CWD$DIR"; }
    else                 { $NEW = "$CWD/$DIR"; }
  }
  else {
    $NEW="$DIR";
  }

  # print "Dir $NEW\n";

  if ( ! goodpath("$DIR") ) { print "Bad directory $DIR to recurse into (from $CWD)\n"; return; }
  if ( ! goodpath("$NEW") ) { print "Bad directory $NEW to recurse into\n"; return; }
  @statn = lstat("$DIR"); $#statn = 1;
  if ( ! -d _ ) { print "Not a directory $NEW to recurse into\n"; return; }

  if ( "$CWD" ne '' ) {
    if ( "@statc" eq "@statn" ) { print "Directory $DIR same as parent $CWD ??\n"; return; }
    if ( "$statc[0]" ne "$statn[0]" ) { print "Directory $DIR on different device from parent $CWD ??\n"; return; }
  }

  if ( ! chdir("$DIR") ) { print "Cannot chdir to $NEW\n"; return; }

  @stato = lstat("."); $#stato = 1;
  if ( "@statn" ne "@stato" ) {
    print "chdir($DIR) did not get us into $NEW ??\n";
  }
  else {
    $nam = fullpath('.');    # Do we need this check? Are we paranoid? YES! (Hard-linked directories??)
    if ( $nam !~ m!^/! ) { print "Error resolving $NEW ?? $nam\n"; }
    elsif ( "$nam" ne "$NEW" ) { print "But $NEW is not full pathname $nam ??\n"; }
    else {
      if ( $NEW =~ m!/$! ) { $NEWD = "$NEW"; }
      else                 { $NEWD = "$NEW/"; }
      @dlist = (); # Keep directories we find and recurse after we close DHR
      opendir (DHR,".") || err ("Cannot read directory $NEW ??");
      while ( $nam = readdir(DHR) ) {
        if ( $nam eq '.' || $nam eq '..' ) { next; }
        if ( ! goodpath("$nam") )      { print "Bad leafname in $NEW: $nam\n"; next; }
        if ( $nam =~ m!/! )            { print "Bad leafname in $NEW: $nam\n"; next; }
        if ( ! goodpath("$NEWD$nam") ) { print "Bad pathname $NEWD$nam\n"; next; }
        @stato = lstat("$nam");
        if ( -d _ ) { push (@dlist, ($nam)); }
        else { action ("$NEWD$nam"); }
      }
      closedir (DHR) || err ("Cannot stop reading directory $NEW ??");

      foreach $nam (@dlist) {
        recurse ("$NEW", "$nam");
        @stato = lstat("$nam");
        action ("$NEWD$nam");
      }
    }
  }

  if ( "$CWD" ne '' ) {
    chdir("..") || err ("Cannot chdir to $NEW/..\n");
    @stato = lstat("."); $#stato = 1;
    if ( "@statc" ne "@stato" ) { err ("Did not get back to $CWD after chdir($DIR);chdir(..)"); }
  }
}


sub action {
  my ($file) = @_;
  my ($n);

  foreach $n (@PRESERVE) {
    if ( "$file" eq "$n" ) { return; }
  }

  if  ( ! -e _ ) { print "$file disappeared ??\n"; return; }
  elsif ( -d _ ) { if (                -M _ < $AGE || -C _ < $AGE ) { return; } }
  elsif ( -f _ ) { if ( -A _ < $AGE || -M _ < $AGE || -C _ < $AGE ) { return; } }
  elsif ( -l _ ) { if (                -M _ < $AGE || -C _ < $AGE ) { return; } }
  elsif ( -p _ ) { if ( -A _ < $AGE || -M _ < $AGE || -C _ < $AGE ) { return; } }
  elsif ( -S _ ) { if ( -A _ < $AGE || -M _ < $AGE || -C _ < $AGE ) { return; } }
  else           { print "Weird type object $file ??\n"; return; }

  saferm_fork ("$file", 1);
}


# Clean up directory $DIR (e.g. /tmp) of objects older than $AGE days.
# Leave alone all objects mentioned in @PRESERVE.
sub cleanup {
  (my ($DIR), $AGE, @PRESERVE) = @_;
  my ($FULL);

  $FULL = fullpath("$DIR");
  if ( "$FULL" ne "$DIR" ) {
    if ( $FULL !~ m!^/! ) { print "$FULL\n"; return; }
    print "Doing $FULL instead of $DIR\n";
  }

  # print "Working on $FULL, age $AGE";
  # if ( "@PRESERVE" ne '' ) { print ", preserve @PRESERVE"; }
  # print "\n";

  recurse ('', $FULL);
}



cleanup ('/tmp', 2, '/tmp/.X11-unix/X0', '/tmp/.X11-unix');
cleanup ('/usr/var/tmp', 7, '/usr/var/tmp/lm_TMW4.ld', '/usr/var/tmp/lm_TMW4.vd1', '/usr/var/tmp/lm_TMW4.dat', '/usr/var/tmp/Matrix_tutorial', '/usr/var/tmp/Spida_tutorial', '/usr/var/tmp/Splus_tutorial', '/usr/var/tmp/.flexlm');
cleanup ('/usr/var/preserve', 7);
if ( -d '/usr/lib/emacs/lock' ) { # Not present on dUnix V4 machines
  cleanup ('/usr/lib/emacs/lock', 3);
}

#!#