CGI::ValidOp::Check::sql - CGI::ValidOp::Check module to validate SQL.


CGI-ValidOp documentation Contained in the CGI-ValidOp distribution.

Index


Code Index:

NAME

Top

CGI::ValidOp::Check::sql - CGI::ValidOp::Check module to validate SQL.

DESCRIPTION

Top

default

Fails if incoming value contains characters other than: \w \s . : [ ] _ ^ * / % + - <> = ~ ! @ # & | ` ? $ ( ) , ; ' "

safer

Named "safer" since allowing users to write SQL can never be truly "safe." This check attempts to allow only things which will not harm data. It doesn't prevent a clever query from wreaking other havoc, though, like a DOS.

safer_select

Just like "safer" but allows 'SELECT'.

AUTHOR

Top

Randall Hansen <legless@cpan.org>

COPYRIGHT

Top


CGI-ValidOp documentation Contained in the CGI-ValidOp distribution.

package CGI::ValidOp::Check::sql;
use strict;
use warnings;

use base qw/ CGI::ValidOp::Check /;

sub default {
    (
        qr|^[\w\s\.:\[\]_\^\*/%+<>=~!@#&\|`\?\$\(\),;'"-]+$|,
        q{Only letters, numbers, and the following punctuation are allowed for $label: .  : [ ] _ ^ * / % + - <> = ~ !  @ # & | ` ?  $ ( )  , ; ' "},
    )
}

sub safer {
    my $self = shift;
    sub {
        my( $value ) = @_;

        my $error = _safer( $value );
        return $self->fail( $error )
            if $error;

        return $self->fail( "SELECT statement not allowed for \$label" )
            if $value =~ /select/i;
        $value =~ /^(.*)$/s;
        return $self->pass( $1 );
    }
}

sub safer_select {
    my $self = shift;
    sub {
        my( $value ) = @_;

        my $error = _safer( $value );
        return $self->fail( $error )
            if $error;

        $value =~ /^(.*)$/s;
        return $self->pass( $1 );
    }
}

sub _safer {
    my( $value ) = @_;

    return "Semicolons not allowed for \$label"
        if $value =~ /[;]/;
    return "Dashes not allowed for \$label"
        if $value =~ /[-]/;
    return "DELETE statement not allowed for \$label"
        if $value =~ /delete/i;
    return "DROP statement not allowed for \$label"
        if $value =~ /drop/i;
    return "UPDATE statement not allowed for \$label"
        if $value =~ /update/i;
    return "INTO statement not allowed for \$label"
        if $value =~ /into/i;
    return;
}

1;

__END__