From news.ecn.bgu.edu!wupost!howland.reston.ans.net!agate!netsys!pagesat!news.cerf.net!netlabs!lwall Mon Apr 12 19:24:35 CDT 1993
Article: 2034 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:2034
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!wupost!howland.reston.ans.net!agate!netsys!pagesat!news.cerf.net!netlabs!lwall
From: lwall@netlabs.com (Larry Wall)
Subject: Re: taintperl question
Message-ID: <1993Apr5.195508.19731@netlabs.com>
Sender: news@netlabs.com
Nntp-Posting-Host: scalpel.netlabs.com
Organization: NetLabs, Inc.
References: <1993Apr1.195609.26288@xact.demon.co.uk>
Date: Mon, 5 Apr 1993 19:55:08 GMT
Lines: 127

In article <1993Apr1.195609.26288@xact.demon.co.uk> ptm@xact.demon.co.uk (Paul Thomas Mahoney) writes:
: I've just got myself completely mixed up... :-(
: 
: I've got taintperl install setuid root.
: 
: I've got a simple perl script... all it does is create a file. This script
: is owned by uucp and belongs to group mail. Its permissions are setuid and
: setgid.
: 
: When, as root I run the script the file is created, but with roots uid and gid.
: Not with uid uucp and gid mail as I would wish.
: 
: Can someone put me straight about this?

You do not want to have taintperl installed setuid root.  If any
program needs to be installed setuid root, it's suidperl, which does
setuid emulation on systems for which the setuid bit is ignored on #!
scripts.  If you're not on such a system, you have to use a wrapper C
program instead to give setuidness to a non-setuid script.  I will
include a copy of suidscript, which writes wrappers for you.

Larry

#!/usr/bin/perl
'di';
'ig00';
#
# $Header: suidscript,v 1.1 90/08/11 13:51:29 lwall Locked $
#
# $Log:	suidscript,v $
# Revision 1.1  90/08/11  13:51:29  lwall
# Initial revision
# 

$xdev = '-xdev' unless -d '/dev/iop';

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

    while (<DF>) {
	chop;
	$_ .= <DF> if length($_) < 50;
	@ary = split;
	push(@list,$ary[2]) if ($ary[0] =~ m|^/dev|);
    }
}
$fslist = join(' ',@list);

die "Can't find local filesystems" unless $fslist;

open(FIND,
  "find $fslist $xdev -type f \\( -perm -04000 -o -perm -02000 \\) -print|");

while (<FIND>) {
    chop;
    next unless -T;
    print "Fixing ", $_, "\n";
    ($dir,$file) = m|(.*)/(.*)|;
    chdir $dir || die "Can't chdir to $dir";
    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
       $blksize,$blocks) = stat($file);
       die "Can't stat $_" unless $ino;
    chmod $mode & 01777, $file;		# wipe out set[ug]id bits
    rename($file,".$file");
    open(C,">.tmp$$.c") || die "Can't write C program for $_";
    $real = "$dir/.$file";
    print C '
main(argc,argv)
int argc;
char **argv;
{
    execv("' . $real . '",argv);
}
';
    close C;
    system '/bin/cc', ".tmp$$.c", '-o', $file;
    die "Can't compile new $_" if $?;
    chmod $mode, $file;
    chown $uid, $gid, $file;
    unlink ".tmp$$.c";
    chdir '/';
}
##############################################################################

	# These next few lines are legal in both Perl and nroff.

.00;			# finish .ig
 
'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
'; __END__ ############# From here on it's a standard manual page ############
.TH SUIDSCRIPT 1 "July 30, 1990"
.AT 3
.SH NAME
suidscript \- puts a compiled C wrapper around a setuid or setgid script
.SH SYNOPSIS
.B suidscript [dirlist]
.SH DESCRIPTION
.I Suidscript
creates a small C program to execute a script with setuid or setgid privileges
without having to set the setuid or setgid bit on the script, which is
a security problem on many machines.
Specify the list of directories or files that you wish to process.
The names must be absolute pathnames.
With no arguments it will attempt to process all the local directories
for this machine.
The scripts to be processed must have the setuid or setgid bit set.
The suidscript program will delete the bits and set them on the wrapper.
.PP
Non-superusers may only process their own files.
.SH ENVIRONMENT
No environment variables are used.
.SH FILES
None.
.SH AUTHOR
Larry Wall
.SH "SEE ALSO"
.SH DIAGNOSTICS
.SH BUGS
.ex