comment on

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,
    },
}
[download]

#!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;
}
[download]

~Particle ;Þ

In reply to proper untainting and use of ref by particle

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Just another Perl shrine
	PerlMonks