#/usr/bin/perl

# Usage: suidscript [dirlist]

# Make list of filenames to do find on.

if ($#ARGV >= 0) {
   @list = @ARGV;
   foreach $name (@ARGV) {
       die "You must use absolute pathnames.\n"
           unless $name =~ m|^/|;
   }
}
else {
   open(MT,"/etc/mount|") || die "Can't run /etc/mount: $!\n";

   while (<MT>) {
       chop;
       $_ .= <MT> if length($_) < 50;
       @ary = split;
       push(@list,$ary[2]) if ($ary[0] =~ m|^/dev|);
   }
   close MT;
   $? && die "Couldn't run mount.\n";
}

die "Can't find local filesystems" unless @list;

# Find all the set-id files.

open(FIND, "find @list -xdev -type f " .
   "\\( -perm -04000 -o -perm -02000 \\) -print|");

while (<FIND>) {
   chop;
   next unless -T;                  # Not a text file.

   # Move script out of the way.

   print "Fixing ", $_, "\n";
   ($dir,$file) = m#(.*)/(.*)#;
   chdir $dir || die "Can't chdir to $dir: $!\n";
   ($dev,$ino,$mode,$nlink,$uid,$gid) = stat($file);
   die "Can't stat $_" unless $ino;
   chmod $mode & 01777, $file;      # wipe out set[ug]id bits
   rename($file,".$file");

   # Now write the wrapper.

   open(C,">.tmp$$.c") || die "Can't write C program for $_";
   $real = "$dir/.$file";
   print C <<EOW;
main(argc,argv)
int argc;
char **argv;
{
   execv("$real",argv);
}
EOW
   close C;

   # Now compile the wrapper.

   system '/bin/cc', ".tmp$$.c", '-o', $file;
   die "Can't compile new $_" if $?;

   # Straighten out loose ends.

   chown $uid, $gid, $file;
   chmod $mode, $file;
   unlink ".tmp$$.c";
   chdir '/';
}