From owner-freebsd-security  Thu Jun 27 04:40:25 1996
Return-Path: owner-security
Received: (from root@localhost)
          by freefall.freebsd.org (8.7.5/8.7.3) id EAA19808
          for security-outgoing; Thu, 27 Jun 1996 04:40:25 -0700 (PDT)
Received: from irs.inf.tu-dresden.de (irs.inf.tu-dresden.de [141.76.1.17])
          by freefall.freebsd.org (8.7.5/8.7.3) with SMTP id EAA19731
          for <freebsd-security@FreeBSD.ORG>; Thu, 27 Jun 1996 04:39:35 -0700 (PDT)
Received: by irs.inf.tu-dresden.de (8.6.12/8.6.12-s1) id NAA10077; Thu, 27 Jun 1996 13:37:47 +0200
Date: Thu, 27 Jun 1996 13:37:47 +0200
Message-Id: <199606271137.NAA10077@irs.inf.tu-dresden.de>
To: guido@gvr.win.tue.nl (Guido van Rooij)
Cc: freebsd-security@FreeBSD.ORG, bugs@sax.sax.de
In-reply-to: guido@gvr.win.tue.nl's message of Thu, 27 Jun 1996 00:06:49 +0200 (MET DST)
Subject: Re: CERT Advisory CA-96.12 - Vulnerability in suidperl (fwd)
From: hohmuth@inf.tu-dresden.de (Michael Hohmuth)
References: <199606261914.NAA05459@rocky.mt.sri.com>
	<199606262206.AAA24375@gvr.win.tue.nl>
Sender: owner-security@FreeBSD.ORG
X-Loop: FreeBSD.org
Precedence: bulk

In article <199606262206.AAA24375@gvr.win.tue.nl> guido@gvr.win.tue.nl
(Guido van Rooij) writes:

> Nate Williams wrote:
> > >     I believe this applies to perl4 as shipped with all versions of
> > > FreeBSD, as well as the perl5 packages/ports.  Does anyone know what
> > > the actual vulnerability is?
> > 
> > I don't, but thanks for bringing this up.  I was planning on bringing
> > this in but I forgot.  I just applied the suggested change to the
> > version of perl in -stable and -current, so it'll be in 2.1.5.
> > 
> 
> We already were no longer vulnerable. Howver, the applied fix won;t hurt.

When the advisory appeared, I applied the fix (fixsuid4-0.pat) to our
2.1.0 system.  However, afterwards our PPP login script ceased to
work, so I had to back out the patch.

The login script (used as the login shell for our PPP accounts) just
said:

  Can't open perl script "/dev/fd/3//usr/local/sbin/ppplogin": Not a directory

I'll append a copy of the script below for those interested.

Can anyone shed some light on what was going on?

I understand from Guido's post that 2.1.0 is not vulnerable even if
the Perl4 patch has not been allpied.  Is this correct?

If this is the case, I suggest backing out the patch from -stable and
-current as well.

Thanks in advance,
Michael
-- 
Email: hohmuth@inf.tu-dresden.de
WWW:   http://www.inf.tu-dresden.de/~mh1/

------------------------------------------------------------------------------

#!/usr/bin/suidperl
#
#
# login script for PPP logins
#

$ENV{'PATH'} = "/bin:/usr/bin:/sbin:/usr/sbin";

#
# Q: how to check if the fork succeeded?
# A: ask Larry Wall :-/
#
open(LOG, "|-") || exec "logger", "-p", "local0.debug";


if(open(SLHOST, "/etc/sliphome/slip.hosts") == 0) {
    print LOG "Cannot open /etc/sliphome/slip.hosts\n";
    close LOG;
    exit 1;
}

if(!defined($ENV{'USER'})) {
    print LOG "PPP login with unknown \${USER}\n";
    close LOG;
    exit 1;
}

$user = $ENV{'USER'};
$sluser = $user;
$sluser =~ s/^pp/sl/;

while(<SLHOST>) {
    next if /^([ \t]*\#.*)?$/;
    ($login,$local,$remote,$mask) = split;
    last if $login eq $sluser;
}

close(SLHOST);

if($local eq "" || $remote eq "" || $mask eq "" || $login ne $sluser) {
    print LOG "PPP login for user $user, required information not found\n";
    close LOG;
    exit 1;
}

print LOG "$user ($sluser/$login) attached, $local -> $remote, mask $mask\n";

$local = &convaddr($local);
$remote = &convaddr($remote);
$mask = &convaddr($mask);

print LOG "$user attached, $local -> $remote, mask $mask\n";

close LOG;

exec "pppd", "crtscts", "modem",
    "$local:$remote", "netmask", "$mask";

# should not be reached at all
open(LOG, "|-") || exec "logger", "-p", "local0.debug";
print LOG "exec of pppd failed for user $user\n";
close(LOG);
exit 2;

#
# convert address to dotted quad
#
sub convaddr
{
    local($input) = @_;
    local($ip,$a,$b,$c,$d);

    # return if already dotted quad
    return $input if $input =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/;

    if($input =~ /^0[xX]/) {
	$ip = oct($input);
	return sprintf("%d.%d.%d.%d", ($ip >> 24) & 0xff,
		       ($ip >> 16) & 0xff, ($ip >> 8) & 0xff,
		       $ip & 0xff);
    }

    # neither dotted quad, nor hex number, ask the name server
    ($name,$aliases,$addrtype,$length,$addr) = gethostbyname($input);
    ($a,$b,$c,$d) = unpack("C4",$addr);
    return "$a.$b.$c.$d";
}