DBIx-Safe-1.2.5/0000755000175000017500000000000010704732317011617 5ustar greggregDBIx-Safe-1.2.5/.perlcriticrc0000644000175000017500000000362610704731603014311 0ustar greggreg ## perlcritic file for DBIx::Safe ## Usage: perlcritic -profile verbose = 8 severity = 1 [-Bangs::ProhibitFlagComments] [-Bangs::ProhibitNumberedNames] [-Bangs::ProhibitVagueNames] [-CodeLayout::ProhibitHardTabs] [-CodeLayout::ProhibitParensWithBuiltins] [-CodeLayout::RequireTidyCode] [-ControlStructures::ProhibitCascadingIfElse] [-ControlStructures::ProhibitCStyleForLoops] [-ControlStructures::ProhibitDeepNests] [-ControlStructures::ProhibitPostfixControls] [-ControlStructures::ProhibitUnlessBlocks] [-Documentation::PodSpelling] [-Documentation::RequirePodSections] [-Documentation::RequirePODUseEncodingUTF8] [-ErrorHandling::RequireCarping] [-ErrorHandling::RequireUseOfExceptions] [-InputOutput::RequireBracedFileHandleWithPrint] [-Lax::ProhibitEmptyQuotes::ExceptAsFallback] [-Miscellanea::ProhibitTies] [-Miscellanea::RequireRcsKeywords] [-Modules::ProhibitMultiplePackages] [-Modules::PerlMinimumVersion] [-References::ProhibitDoubleSigils] [-RegularExpressions::RequireExtendedFormatting] [-RegularExpressions::RequireLineBoundaryMatching] [-Subroutines::ProhibitExcessComplexity] [-Subroutines::RequireArgUnpacking] [-TestingAndDebugging::ProhibitNoWarnings] [-Tics::ProhibitLongLines] [-ValuesAndExpressions::ProhibitAccessOfPrivateData] [-ValuesAndExpressions::ProhibitCommaSeparatedStatements] [-ValuesAndExpressions::ProhibitEmptyQuotes] [-ValuesAndExpressions::ProhibitInterpolationOfLiterals] [-ValuesAndExpressions::ProhibitMixedBooleanOperators] [-ValuesAndExpressions::ProhibitNoisyQuotes] [-ValuesAndExpressions::ProhibitVersionStrings] [-ValuesAndExpressions::RequireNumberSeparators] [-ValuesAndExpressions::RestrictLongStrings] [-Variables::ProhibitLocalVars] [-Variables::ProhibitPackageVars] [-Variables::ProhibitPunctuationVars] [-Modules::RequireVersionVar] [CodeLayout::ProhibitTrailingWhitespace] severity = 5 [Subroutines::ProhibitBuiltinHomonyms] severity = 5 DBIx-Safe-1.2.5/META.yml0000644000175000017500000000200410703527340013061 0ustar greggreg--- #YAML:1.0 name : DBIx-Safe version : 1.2.5 abstract : Safe wrapper to DBI interface author: - Greg Sabino Mullane license : bsd dynamic_config : 1 distribution_type : module requires: DBI : 1.49 DBD::Pg : 1.49 recommends: Test::Dynamic : 1.3.1 build_requires: Test::Harness : 2.03 Test::More : 0.61 Module::Signature : 0.50 provides: DBIx::Safe: file : Safe.pm version : 1.2.5 resources: homepage : http://bucardo.org/dbix_safe/index.html MailingList : http://bucardo.org/dbix_safe/list.html bugtracker : http://bucardo.org/dbix_safe/bugs.html repository : http://bucardo.org/dbix_safe/repo.html license : http://bucardo.org/dbix_safe/license.html meta-spec: version : 1.3 url : http://module-build.sourceforge.net/META-spec-v1.3.html generated_by : emacs 22.1.1 DBIx-Safe-1.2.5/Safe.pm.html0000644000175000017500000002217310704731655014007 0ustar greggreg DBIx::Safe - Safer access to your database through a DBI database handle

NAME

DBIx::Safe - Safer access to your database through a DBI database handle

VERSION

This documents version 1.2.5 of the DBIx::Safe module

SYNOPSIS

  use DBIx::Safe;
  $dbh = DBI->connect($dbn, $user, $pass, {AutoCommit => 0});
  my $safedbh = DBIx::Safe->new({ dbh => $dbh });
  $safedbh->allow_command('SELECT INSERT UPDATE');
  $safedbh->allow_regex(qr{LOCK TABLE \w+ IN EXCLUSIVE MODE});
  $safedbh->deny_regex(qr{LOCK TABLE pg_});
  $safedbh->allow_attribute('PrintError RaiseError');

DESCRIPTION

The purpose of this module is to give controlled, limited access to an application, rather than simply passing it a raw database handle through DBI. DBIx::Safe acts as a wrapper to the database, by only allowing through the commands you tell it to. It filters all things related to the database handle - methods and attributes.

The typical usage is for your application to create a database handle via a normal DBI call to new(), then pass that to DBIx::Safe->new(), which will return you a DBIx::Safe object. After specifying exactly what is and what is not allowed, you can pass the object to the untrusted application. The object will act very similar to a DBI database handle, and in most cases can be used interchangeably.

By default, nothing is allowed to run at all. There are many things you can control. You can specify which SQL commands are allowed, by indicating the first word in the SQL statement (e.g. 'SELECT'). You can specify which database methods are allowed to run (e.g. 'ping'). You can specify a regular expression that allows matching SQL statements to run (e.g. 'qr{SET TIMEZONE}'). You can specify a regular expression that is NOT allowed to run (e.g. qr(UPDATE xxx}). Finally, you can indicate which database attributes are allowed to be read and changed (e.g. 'PrintError'). For all of the above, there are matching methods to remove them as well.

Deciding what statements to allow

Anytime a statement is sent to the server via the DBIx::Safe database handle, it is first examined to see if it is allowed to run or not. There are three major checks that occur when a statement is sent. First, the initial word of the statement, known as the command, is extracted. Next, the entire statement is checked against the list of denied regular expressions. Next, the command is checked against the list of allowed commands. If there is no match, the statement is checked against the list of allowed regular expressions.

Each DBD may implement additional or slightly different checks. For example, if using Postgres, no semi-colons are allowed unless the command is one of SELECT, INSERT, UPDATE, or DELETE, to prevent multiple commands from running. (The four listed commands can be checked in another way for multiple commands, so they are allowed to have semicolons).

Deciding what attributes to allow

Database handle attributes are controlled by a single list of allowed keys. If the key is allowed, the underlying database handle value is returned or changed (or both). Note that the attribute ``AutoCommit'' is never allowed to be changed.

Methods

new()

Creates a new DBIx::Safe object. Requires a mandatory ``dbh'' argument containing an active database handle. Optional arguments are ``allow_command'', ``allow_regex'', ``deny_regex'', and ``allow_attribute''.

allow_command()

Specifies which commands are allowed to be used. Can be a whitespace-separated list of words in a string, or an arrayref of such strings. Returns the current list of allowed commands. Duplicate commands will throw an error.

unallow_command()

Same as allow_command, but will remove words from the list.

allow_regex()

Specifies regular expressions which are allowed to run. Argument must be a regular expression, or an arrayref of regular expressions. Returns the current list.

unallow_regex()

Same as allow_regex, but will remove regexes from the list.

deny_regex()

Specifies regular expressions which are NOT allowed to run. Arguments and return the same as allow_regex().

undeny regex()

Same as deny_regex, but will remove regexes from the list.

allow_attribute()

Specifies database handle attributes that are allowed to be changed. By default, nothing can be read. Argument is a whitespace-separated list of words in a string, or an arrayref of such strings. Returns the current list.

unallow_attribute()

Same as allow_attributes, but removes attributes from the list.

Testing

DBIx::Safe has a very comprehensive test suite, so please use it! The only thing you should need is a database connection, by setting the environment variables DBI_DSN and DBI_USER (and DBI_PASS if needed).

You can optionally run the module through Perl::Critic by setting the TEST_AUTHOR environment variable. You will need to have the modules Perl::Critic and Test::Perl::Critic installed.

Please report any test failures to the author or bucardo-general@bucardo.org.

Supported Databases

Due to the difficulty of ensuring safe access to the database, each type of database must be specifically written into DBIx::Safe. Current databases supported are: Postgres (DBD::Pg).

WEBSITE

The latest version and other information about DBIx::Safe can be found at: http://bucardo.org/dbix_safe/

DEVELOPMENT

The latest development version can be checked out by using git:

  git clone http://bucardo.org/dbixsafe.git/

BUGS

Bugs should be reported to the author or bucardo-general@bucardo.org.

AUTHOR

Greg Sabino Mullane <greg@endpoint.com>

LICENSE AND COPYRIGHT

Copyright 2006-2007 Greg Sabino Mullane <greg@endpoint.com>.

This software is free to use: see the LICENSE file for details.

DBIx-Safe-1.2.5/Changes0000644000175000017500000000056710704727511013122 0ustar greggregRevision history for DBIx::Safe 1.2.5 Break test into three files, handle no db connection more gracefully. 1.2.4 September 2007 Public release 1.2.0 Change to a pseudo-inside-out structure 1.1.9 Fully functioning version, Postgres support only 1.0.0 Original design by Jon Jensen and Greg Sabino Mullane DBIx-Safe-1.2.5/Safe.pm0000644000175000017500000004574610704731046013051 0ustar greggreg# -*-cperl-*- # # Copyright 2006-2007 Greg Sabino Mullane # # DBIx::Safe is a safer way of handling database connections. # You can specify exactly which commands can be run. # package DBIx::Safe; use 5.008003; use utf8; use strict; use warnings; use IO::Handle; use DBI 1.42; { our $VERSION = '1.2.5'; *STDOUT->autoflush(1); *STDERR->autoflush(1); my %inner; sub TIEHASH { my $class = shift; my $arg = shift; my $self = bless {}, $class; $inner{$self} = $arg; return $self; } sub STORE { my ($self,$key,$value) = @_; my $inner = $inner{$self}; my $origkey = $key; $key = lc $key; die "Invalid access\n" unless index $key, 'dbixsafe_'; if (exists $inner->{dbixsafe_allow_attribute}{$key}) { $inner->{dbixsafe_allow_attribute}{$key}++; $inner->{dbixsafe_sdbh}{$origkey} = $value; return; } die qq{Cannot change attribute "$key"}; } sub FETCH { my ($self,$key) = @_; my $inner = $inner{$self}; die "Invalid access\n" unless index $key, 'dbixsafe_'; ## Assume it is a $dbh value, and return it return $inner->{dbixsafe_sdbh}{$key}; } sub FIRSTKEY { my $self = shift; my $inner = $inner{$self}; my $foo = keys %{$inner->{dbixsafe_sdbh}}; return each %{$inner->{dbixsafe_sdbh}}; } sub new { my $class = shift; my $arg = shift; ref $arg and ref $arg eq 'HASH' or die qq{Method new() requires a hashref arguments}; exists $arg->{dbh} or die qq{Required argument 'dbh' was not found\n}; my $sdbh = $arg->{dbh}; ref $sdbh and ref $sdbh eq 'DBI::db' or die qq{Argument 'dbh' is not a database handle\n}; ## This is where the real information is stored my %self = ( dbixsafe_sdbh => $sdbh, dbixsafe_allow_command => {}, dbixsafe_allow_regex => {}, dbixsafe_deny_regex => {}, dbixsafe_allow_attribute => {}, ); ## Now let's make sure we know how to handle this type of database my $db = $sdbh->{Driver}{Name} or die qq{Failed to figure out driver name\n}; if ($db eq 'Pg') { $self{dbixsafe_db} = 'Postgres'; ## Make sure we have the required versions my $libversion = $sdbh->{pg_lib_version}; $libversion =~ /^\d+$/ and $libversion >= 80000 or die qq{Must use a DBD::Pg compiled against version 8.0 or higher, this is $libversion\n}; my $version = $sdbh->{pg_server_version}; $libversion =~ /^\d+$/ and $libversion >= 70400 or die qq{Must use against a Postgres server version 7.4 or higher, this is $version\n}; } # end Postgres else { die "Sorry, I do not work with that type of database yet: $db\n"; } ## We'll be returning a tied hashref as the object my %object; my $codename = bless \%object, $class; $inner{$codename} = \%self; tie %object, 'DBIx::Safe', \%self; if (exists $arg->{allow_command}) { $self{dbixsafe_allow_command} = allow_command($codename, $arg->{allow_command}); } if (exists $arg->{allow_regex}) { $self{dbixsafe_allow_regex} = allow_regex($codename, $arg->{allow_regex}); } if (exists $arg->{deny_regex}) { $self{dbixsafe_deny_regex} = deny_regex($codename, $arg->{deny_regex}); } if (exists $arg->{allow_attribute}) { $self{dbixsafe_allow_attribute} = allow_attribute($codename, $arg->{allow_attribute}); } return $codename; } ## end of new sub DESTROY { my $self = shift; delete $inner{$self}; return; } ## Specifically unsupported database handle methods sub prepare_cached { my $self = shift; die qq{Method prepare_cached() not supported yet\n}; } sub safeprepare { ## The main gatekeeper my $self = shift; my $type = shift; my $string = shift; $self = $inner{$self}; die "Invalid type passed to safeprepare\n" unless $type =~ /^(?:do|prepare)$/io; ## Figure out the first word in the statement $string =~ s/^\s*(\w+)\s*/$1 / or die qq{Could not find first word in string "$string"\n}; my $firstword = lc $1; ## no critic ## We flat out do not allow some commands in SQL statements my %transword = map { $_ => 1 } (qw(begin commit rollback release)); if (exists $transword{$firstword}) { die "Cannot use $firstword in a statement\n"; } ## Check for denied regexes for my $deny (keys %{$self->{dbixsafe_deny_regex}}) { if ($string =~ $deny) { die qq{Forbidden statement\n}; } } my $sdbh = $self->{dbixsafe_sdbh}; if ($self->{dbixsafe_db} eq 'Postgres') { ## Only a few words can pass through pg_prepare_now if ($firstword =~ /^(?:select|update|delete|insert)$/) { if (!exists $self->{dbixsafe_allow_command}{$firstword}) { die qq{(pg) Invalid statement: $string\n}; } local $sdbh->{pg_prepare_now} = 1; my $sth = $sdbh->prepare($string); $self->{dbixsafe_allow_command}{$firstword}++; return $sth if $type eq 'prepare'; return $sth->execute(@_); } } ## Put other DBDs here else { die qq{Do not know how to handle that DBD yet!\n}; } ## Nobody else is allowed to have a semi-colon if ($string =~ /;/) { die qq{Commands cannot contain semi-colons}; } ## Is this an allowed word? my $found = 0; if (exists $self->{dbixsafe_allow_command}{$firstword}) { $self->{dbixsafe_allow_command}{$firstword}++; $found = 1; } else { ## May be allowed as a regular expression for my $regex (keys %{$self->{dbixsafe_allow_regex}}) { ## warn "Checking regex $regex against $string\n"; if ($string =~ /^$regex/) { $self->{dbixsafe_allow_regex}{$regex}++; $found=2; last; } } } $found or die qq{Invalid statement: $string\n}; if ($type eq 'do') { return $sdbh->do($string); } my $sth = $sdbh->prepare($string); return $sth if $type eq 'prepare'; return $sth->execute(@_); } ## end of safeprepare ## Query-related database handle methods sub prepare { my $self = shift; return $self->safeprepare('prepare' => @_); } sub do { my $self = shift; return $self->safeprepare('do' => @_); } sub selectall_arrayref { my ($self, $string, $attr, @bind) = @_; my $sth = (ref $string) ? $string : $self->safeprepare('prepare', $string, $attr); $sth->execute(@bind); my $slice = $attr->{Slice}; # typically undef, else hash or array ref if (!$slice and $slice=$attr->{Columns}) { if (ref $slice eq 'ARRAY') { # map col idx to perl array idx $slice = [ @{$attr->{Columns}} ]; # take a copy for (@$slice) { $_-- } } } my $rows = $sth->fetchall_arrayref($slice, my $MaxRows = $attr->{MaxRows}); $sth->finish if defined $MaxRows; return $rows; } ## end of selectlall_arrayref sub selectall_hashref { my ($self, $string, $key_field, $attr, @bind) = @_; my $sth = (ref $string) ? $string : $self->safeprepare('prepare', $string, $attr); $sth->execute(@bind); return $sth->fetchall_hashref($key_field); } ## end of selectall_hashref sub selectrow_array { my ($self, $string, $key_field, $attr, @bind) = @_; my $sth = (ref $string) ? $string : $self->safeprepare('prepare', $string, $attr); $sth->execute(@bind); my $row = $sth->fetchrow_arrayref() and $sth->finish(); return $row->[0] unless wantarray; return @$row; } ## end of selectrow_array sub selectrow_arrayref { my ($self, $string, $key_field, $attr, @bind) = @_; my $sth = (ref $string) ? $string : $self->safeprepare('prepare', $string, $attr); $sth->execute(@bind); my $row = $sth->fetchrow_arrayref() and $sth->finish(); return $row; } ## end of selectrow_arrayref sub selectrow_hashref { my ($self, $string, $key_field, $attr, @bind) = @_; my $sth = (ref $string) ? $string : $self->safeprepare('prepare', $string, $attr); $sth->execute(@bind); my $row = $sth->fetchrow_hashref() and $sth->finish(); return $row; } ## end of selectrow_hashref sub selectcol_arrayref { my ($self, $string, $attr, @bind) = @_; my $sth = (ref $string) ? $string : $self->safeprepare('prepare', $string, $attr); $sth->execute(@bind); my @columns = ($attr->{Columns}) ? @{$attr->{Columns}} : (1); my @values = (undef) x @columns; my $idx = 0; for (@columns) { $sth->bind_col($_, \$values[$idx++]) || return; } my @col; if (my $max = $attr->{MaxRows}) { push @col, @values while @col<$max && $sth->fetch; } else { push @col, @values while $sth->fetch; } return \@col; } ## end of selectcol_hashref ## All other database handle methods we support sub dbh_method { my $self = shift; (my $method = (caller 1)[3]) =~ s/^DBIx::Safe::(\w+)$/$1/ or die "Invalid call to change_regex\n"; exists $inner{$self}{dbixsafe_allow_command}{$method} or die qq{Calling method '$method' is not allowed\n}; return $inner{$self}{dbixsafe_sdbh}->$method(@_); } sub quote { return dbh_method(@_); } sub quote_identifier { return dbh_method(@_); } sub last_insert_id { return dbh_method(@_); } sub table_info { return dbh_method(@_); } sub column_info { return dbh_method(@_); } sub primary_key_info { return dbh_method(@_); } sub get_info { return dbh_method(@_); } sub data_sources { return dbh_method(@_); } sub can { return dbh_method(@_); } sub parse_trace_flag { return dbh_method(@_); } sub parse_trace_flags { return dbh_method(@_); } ## Read-only, no args sub ping { return dbh_method(@_); } sub err { return dbh_method(@_); } sub errstr { return dbh_method(@_); } sub state { return dbh_method(@_); } ## no critic ## Write-only sub trace_msg { return dbh_method(@_); } sub func { return dbh_method(@_); } ## Transactional sub commit { return dbh_method(@_); } sub rollback { return dbh_method(@_); } sub begin_work { return dbh_method(@_); } ## Postgres specific sub pg_savepoint { return dbh_method(@_); } sub pg_rollback_to { return dbh_method(@_); } sub pg_release { return dbh_method(@_); } ## Special case database handle methods sub trace { my $self = shift; exists $inner{$self}{dbixsafe_allow_command}{trace} or !@_ or die qq{Calling method 'trace' with arguments is not allowed\n}; return $inner{$self}{dbixsafe_sdbh}->trace(@_); } ## Generic internal list modifiers sub change_string { ## Adds or removes one or more strings from an internal list ## Returns the new list, even if no args my ($self,$arg) = @_; (my $method = (caller 1)[3]) =~ s/^DBIx::Safe::(\w+)$/$1/ or die "Invalid call to change_regex\n"; my $key = $method; my $type = ($key =~ s/^un//) ? 'remove' : 'add'; my $list = $inner{$self}{"dbixsafe_$key"} or die qq{Invalid method call: $method\n}; defined $arg or return $list; my $usage = qq{Method $method must be passed a string or an array of them\n}; my $strictdoubles = 1; my $strictexists = 0; my %string; if (ref $arg) { ref $arg eq 'ARRAY' or die $usage; for my $s (@$arg) { if (exists $string{lc $s} and $strictdoubles) { die qq{Method $method was passed in duplicate argument: $s\n}; } $string{lc $s}++; } } else { $string{$arg}++; } my %command; for my $s (keys %string) { $s =~ s/^\s*(.+)\s*$/$1/; for my $c (split /\s+/ => lc $s) { if ($c !~ /^[a-z_]+$/) { die qq{Method $method was passed an invalid argument: $c\n}; } if (exists $command{$c} and $strictdoubles) { die qq{Method $method was passed in duplicate argument: $c\n}; } if ($type eq 'remove') { if (! exists $list->{$c} and $strictexists) { die qq{Method $method was passed in non-existent argument: $c\n}; } } else { if (exists $list->{$c} and $strictexists) { die qq{Method $method was passed in already existing argument: $c\n}; } } $command{$c}++; } } for my $c (keys %command) { if ($type eq 'remove') { delete $list->{$c}; } else { if ($c eq 'autocommit') { ## We don't hardcode the method here: too easy to accidentally break die qq{Attribute AutoCommit cannot be changed}; } $list->{$c} = 0; } } return $list; } ## end of change_string sub change_regex { ## Adds or removes one or more regular expressions from an internal list ## Returns the new list, even if no args my ($self,$arg) = @_; (my $method = (caller 1)[3]) =~ s/^DBIx::Safe::(\w+)$/$1/ or die "Invalid call to change_regex\n"; my $key = $method; my $type = ($key =~ s/^un//) ? 'remove' : 'add'; my $list = $inner{$self}{"dbixsafe_$key"} or die "Invalid nethod call: $method\n"; defined $arg or return $list; my $usage = qq{Method $method must be passed a regular expression or an array of them\n}; ref $arg or die $usage; my $strictdoubles = 1; my $strictexists = 0; my %regex; if (ref $arg eq 'ARRAY') { for my $r (@$arg) { ref $r and ref $r eq 'Regexp' or die $usage; if (exists $regex{$r} and $strictdoubles) { die qq{Method $method was passed in duplicate regexes for $r\n}; } $regex{$r}++; } } elsif (ref $arg eq 'Regexp') { $regex{$arg}++; } else { die $usage; } for my $r (keys %regex) { if ($type eq 'remove') { if (! exists $list->{$r} and $strictexists) { die qq{Method $method was passed in a non-existent regex: $r\n}; } delete $list->{$r}; } else { if (exists $list->{$r} and $strictexists) { die qq{Method $method was passed in an already existing regex: $r\n}; } $list->{$r} ||= 0; } } return $list; } ## end of change_regex sub allow_command { return change_string(@_); } sub unallow_command { return change_string(@_); } sub allow_attribute { return change_string(@_); } sub unallow_attribute { return change_string(@_); } sub unallow_regex { return change_regex(@_); } sub undeny_regex { return change_regex(@_); } sub deny_regex { return change_regex(@_); } sub allow_regex { return change_regex(@_); } } 1; __END__ =pod =head1 NAME DBIx::Safe - Safer access to your database through a DBI database handle =head1 VERSION This documents version 1.2.5 of the DBIx::Safe module =head1 SYNOPSIS use DBIx::Safe; $dbh = DBI->connect($dbn, $user, $pass, {AutoCommit => 0}); my $safedbh = DBIx::Safe->new({ dbh => $dbh }); $safedbh->allow_command('SELECT INSERT UPDATE'); $safedbh->allow_regex(qr{LOCK TABLE \w+ IN EXCLUSIVE MODE}); $safedbh->deny_regex(qr{LOCK TABLE pg_}); $safedbh->allow_attribute('PrintError RaiseError'); =head1 DESCRIPTION The purpose of this module is to give controlled, limited access to an application, rather than simply passing it a raw database handle through DBI. DBIx::Safe acts as a wrapper to the database, by only allowing through the commands you tell it to. It filters all things related to the database handle - methods and attributes. The typical usage is for your application to create a database handle via a normal DBI call to new(), then pass that to DBIx::Safe->new(), which will return you a DBIx::Safe object. After specifying exactly what is and what is not allowed, you can pass the object to the untrusted application. The object will act very similar to a DBI database handle, and in most cases can be used interchangeably. By default, nothing is allowed to run at all. There are many things you can control. You can specify which SQL commands are allowed, by indicating the first word in the SQL statement (e.g. 'SELECT'). You can specify which database methods are allowed to run (e.g. 'ping'). You can specify a regular expression that allows matching SQL statements to run (e.g. 'qr{SET TIMEZONE}'). You can specify a regular expression that is NOT allowed to run (e.g. qr(UPDATE xxx}). Finally, you can indicate which database attributes are allowed to be read and changed (e.g. 'PrintError'). For all of the above, there are matching methods to remove them as well. =head2 Deciding what statements to allow Anytime a statement is sent to the server via the DBIx::Safe database handle, it is first examined to see if it is allowed to run or not. There are three major checks that occur when a statement is sent. First, the initial word of the statement, known as the command, is extracted. Next, the entire statement is checked against the list of denied regular expressions. Next, the command is checked against the list of allowed commands. If there is no match, the statement is checked against the list of allowed regular expressions. Each DBD may implement additional or slightly different checks. For example, if using Postgres, no semi-colons are allowed unless the command is one of SELECT, INSERT, UPDATE, or DELETE, to prevent multiple commands from running. (The four listed commands can be checked in another way for multiple commands, so they are allowed to have semicolons). =head2 Deciding what attributes to allow Database handle attributes are controlled by a single list of allowed keys. If the key is allowed, the underlying database handle value is returned or changed (or both). Note that the attribute "AutoCommit" is never allowed to be changed. =head2 Methods =head3 new() Creates a new DBIx::Safe object. Requires a mandatory "dbh" argument containing an active database handle. Optional arguments are "allow_command", "allow_regex", "deny_regex", and "allow_attribute". =head3 allow_command() Specifies which commands are allowed to be used. Can be a whitespace-separated list of words in a string, or an arrayref of such strings. Returns the current list of allowed commands. Duplicate commands will throw an error. =head3 unallow_command() Same as allow_command, but will remove words from the list. =head3 allow_regex() Specifies regular expressions which are allowed to run. Argument must be a regular expression, or an arrayref of regular expressions. Returns the current list. =head3 unallow_regex() Same as allow_regex, but will remove regexes from the list. =head3 deny_regex() Specifies regular expressions which are NOT allowed to run. Arguments and return the same as allow_regex(). =head3 undeny regex() Same as deny_regex, but will remove regexes from the list. =head3 allow_attribute() Specifies database handle attributes that are allowed to be changed. By default, nothing can be read. Argument is a whitespace-separated list of words in a string, or an arrayref of such strings. Returns the current list. =head3 unallow_attribute() Same as allow_attributes, but removes attributes from the list. =head2 Testing DBIx::Safe has a very comprehensive test suite, so please use it! The only thing you should need is a database connection, by setting the environment variables DBI_DSN and DBI_USER (and DBI_PASS if needed). You can optionally run the module through Perl::Critic by setting the TEST_AUTHOR environment variable. You will need to have the modules Perl::Critic and Test::Perl::Critic installed. Please report any test failures to the author or bucardo-general@bucardo.org. =head2 Supported Databases Due to the difficulty of ensuring safe access to the database, each type of database must be specifically written into DBIx::Safe. Current databases supported are: Postgres (DBD::Pg). =head1 WEBSITE The latest version and other information about DBIx::Safe can be found at: http://bucardo.org/dbix_safe/ =head1 DEVELOPMENT The latest development version can be checked out by using git: git clone http://bucardo.org/dbixsafe.git/ =head1 BUGS Bugs should be reported to the author or bucardo-general@bucardo.org. =head1 AUTHOR Greg Sabino Mullane =head1 LICENSE AND COPYRIGHT Copyright 2006-2007 Greg Sabino Mullane . This software is free to use: see the LICENSE file for details. =cut DBIx-Safe-1.2.5/t/0000755000175000017500000000000010704732317012062 5ustar greggregDBIx-Safe-1.2.5/t/02perlcritic.t0000644000175000017500000000174210704725706014561 0ustar greggreg#!/usr/bin/perl -- -*-cperl-*- use strict; use warnings; use Test::More; if (! $ENV{TEST_AUTHOR}) { plan (skip_all => 'Must set $ENV{TEST_AUTHOR} to run Perl::Critic tests'); } eval { require Perl::Critic; }; if ($@) { plan (skip_all => 'Perl::Critic needed to run this test'); } eval { require Test::Perl::Critic; }; if ($@) { plan (skip_all => 'Test::Perl::Critic needed to run this test'); } ## Gotta have a profile my $PROFILE = '.perlcriticrc'; if (! -e $PROFILE) { plan (skip_all => qq{Perl::Critic profile "$PROFILE" not found\n}); } ## Gotta have our code my $CODE = './Safe.pm'; if (! -e $CODE) { plan (skip_all => qq{Perl::Critic cannot find "$CODE" to test with\n}); } plan tests => 1; Test::Perl::Critic->import( -profile => $PROFILE ); critic_ok($CODE); #all_critic_ok(); __DATA__ plan tests => 1; my $critic = Perl::Critic->new(-profile => $PROFILE); my @problems = $critic->critique($CODE); is(@problems, 0, "Passed Perl::Critic run"); use Data::Dumper; DBIx-Safe-1.2.5/t/03db.t0000644000175000017500000010146310704727260013005 0ustar greggreg#!/usr/bin/perl -- -*-cperl-*- use strict; use warnings; use Test::More; use Data::Dumper; use vars qw($dbh $SQL $sth $info $expected); ## no critic ## Common error string regexes my $NORUN = qr{Invalid statement:}; my $NOMULTI = qr{cannot insert multiple commands}; my $FORBID = qr{Forbidden statement}; eval { require DBI; DBI->import; }; if ($@) { plan skip_all => 'Must install the DBI module to test DBIx::Safe'; } eval { require DBIx::Safe; }; $@ and BAIL_OUT qq{Could not load the DBIx::Safe module: $@}; eval { $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS}, {AutoCommit=>0,RaiseError=>1,PrintError=>0}); }; if ($@) { plan skip_all => "Cannot test without a valid database connection: make sure DBI_DSN and DBI_USER are set.Error was $@\n"; } else { plan tests => 219; } pass("Connected to the test database"); isa_ok($dbh, 'DBI::db', qq{Got a DBI object}); # # Tests for the new() method # my $safe; eval { $safe = DBIx::Safe->new(); }; like($@, qr{requires a hashref}, qq{Method new() fails with no arguments}); my $fakedbh; eval { $safe = DBIx::Safe->new({dbh=>$fakedbh}); }; like($@, qr{not a database handle}, qq{Method new() fails with invalid "dbh" argument}); ## Check for unknown database type $fakedbh = DBI->connect('dbi:Sponge:', '','',{AutoCommit=>1}); eval { $safe = DBIx::Safe->new({dbh=>$fakedbh}); }; like($@, qr{do not work with that type of database}, qq{Method new() fails with unhandled database type}); eval { $safe = DBIx::Safe->new({dbh=>$dbh, allow_command=>$dbh}); }; my $dbtype = $dbh->{Driver}{Name}; ## May be a bad database if ($@ =~ /do not work with that/) { BAIL_OUT "DBIx::Safe cannot work against the type of database: $dbtype"; } like($@, qr{allow_command must be passed}, qq{Method new() fails with invalid "allow_command" argument}); eval { $safe = DBIx::Safe->new({dbh=>$dbh, allow_command=>[' 14964AC8 ']}); }; like($@, qr{invalid argument}, qq{Method new() fails when "allow_command" arrayref argument contains invalid characters}); eval { $safe = DBIx::Safe->new({dbh=>$dbh, allow_command=>' select '}); }; is($@, q{}, qq{Method new() works when passed valid arguments}); isa_ok($safe, "DBIx::Safe") or BAIL_OUT qq{Cannot continue without a valid DBIx::Safe object}; my $t=q{ DBIx::Safe object is Dumpable}; eval { $info = Dumper $safe; }; is($@, q{}, $t); # # Tests for the allow_command() and unallow_command() methods # eval { $info = $safe->allow_command(); }; is($@, q{}, qq{Method allow_command() returns a list when given no arguments}); is_deeply($info, {select => 0}, qq{Method allow_command() returns correct list}); eval { $safe->allow_command({foobar => 1}); }; like($@, qr{allow_command must be passed}, qq{Method allow_command() fails when passed a hashref}); eval { $safe->allow_command([qw(select insert select)]); }; like($@, qr{duplicate argument}, qq{Method allow_command() fails when passed duplicate commands}); eval { $safe->allow_command('select insert SELECT'); }; like($@, qr{duplicate argument}, qq{Method allow_command() fails when passed duplicate commands}); eval { $safe->allow_command(['select','insert select']); }; like($@, qr{duplicate argument}, qq{Method allow_command() fails when passed duplicate commands}); eval { $safe->allow_command('select!'); }; like($@, qr{invalid argument}, qq{Method allow_command() fails when passed an invalid command}); eval { $info = $safe->allow_command(' update'); }; is($@, q{}, qq{Method allow_command() works with a single command}); is_deeply($info, {select => 0, update => 0}, qq{Method allow_command() returns correct list}); eval { $info = $safe->allow_command([' update',' INSERT DELETE ']); }; is($@, q{}, qq{Method allow_command() works with an arrayref argument}); is_deeply($info, {select => 0, update => 0, insert => 0, delete => 0}, qq{Method allow_command() returns correct list}); eval { $safe->do("SET foobar=1"); }; like($@, $NORUN, qq{Commands not passed to allow_command() cannot be run}); eval { $safe->do("SELECT 123"); }; is($@, q{}, qq{Commands passed to allow_command() can be run}); eval { $info = $safe->unallow_command(); }; is($@, q{}, qq{Method unallow_command() returns a list when given no arguments}); is_deeply($info, {select => 1, update => 0, insert => 0, delete => 0}, qq{Method unallow_command() returns correct list}); eval { $safe->unallow_command(qr{foobar}); }; like($@, qr{unallow_command must be passed}, qq{Method unallow_command() fails when given a regex}); eval { $safe->unallow_command('delete and delete'); }; like($@, qr{duplicate argument}, qq{Method unallow_command() fails when passed duplicate commands}); eval { $safe->unallow_command(['delete',' delete']); }; like($@, qr{duplicate argument}, qq{Method unallow_command() fails when passed duplicate commands}); eval { $safe->unallow_command(['select','insert select']); }; like($@, qr{duplicate argument}, qq{Method unallow_command() fails when passed duplicate commands}); eval { $info = $safe->unallow_command('update'); }; is($@, q{}, qq{Method unallow_command() works with a single command}); is_deeply($info, {select => 1, insert => 0, delete => 0}, qq{Method unallow_command() returns correct list}); eval { $info = $safe->unallow_command([qw(insert delete)]); }; is($@, q{}, qq{Method unallow_command() works with an arrayref argument}); is_deeply($info, {select => 1}, qq{Method unallow_command() returns correct list}); eval { $safe->do("DELETE 123"); }; like($@, $NORUN, qq{Commands passed to unallow_command() can no longer be run}); ## Lots of adding and removing of words $safe->allow_command("A stitch in time saves nine"); $safe->unallow_command("TIME STITCH"); ## a in saves nine $safe->allow_command(['Wild','West']); $safe->unallow_command(['Wild','Nine']); ## a in saves west $safe->allow_command(['GoWest YoungMan ']); $info = $safe->unallow_command('youngman A'); ## in saves west gowest $expected = { gowest => 0, in => 0, saves => 0, select => 1, west => 0, }; is_deeply($info, $expected, qq{Methods allow_command() and unallow_command() work as expected}); ## Cleanup $safe->unallow_command('gowest in saves west'); # # Tests for the allow_regex() and unallow_regex() methods # my $regex1 = q{LOCK TABLE \w{6} IN (SHARE|EXCLUSIVE) MODE}; my $regex2 = q{create temp table }; my $regex3 = q{SET TIMEZONE}; eval { $info = $safe->allow_regex(); }; is($@, q{}, qq{Method allow_regex() returns a list when given no arguments}); is_deeply($info, {}, qq{Method allow_regex() returns correct list}); eval { $safe->allow_regex($regex1); }; like($@, qr{allow_regex must be passed}, qq{Method allow_regex() fails when passed a string}); eval { $safe->allow_regex({foobar => 1}); }; like($@, qr{allow_regex must be passed}, qq{Method allow_regex() fails when passed a hashref}); eval { $safe->allow_regex([qr{$regex1}, qr{$regex1}]); }; like($@, qr{duplicate regexes}, qq{Method allow_regex() fails when passed duplicate regexes}); eval { $safe->allow_regex([qr{$regex1}, $regex2]); }; like($@, qr{allow_regex must be passed}, qq{Method allow_regex() fails when all items in arrayref are not regexes}); eval { $info = $safe->allow_regex(qr{$regex1}); }; is($@, q{}, qq{Method allow_regex() works with a single regex}); is_deeply($info, {qr{$regex1} => 0}, qq{Method allow_regex() returns correct list}); eval { $info = $safe->allow_regex([qr{$regex2}, qr{$regex3}]); }; is($@, q{}, qq{Method allow_regex() works with an arrayref argument}); is_deeply($info, {qr{$regex1} => 0, qr{$regex2} => 0, qr{$regex3} => 0}, qq{Method allow_regex() returns correct list}); eval { $safe->do("LOCK TABLE alphabet"); }; like($@, $NORUN, qq{Regexes not passed to allow_regex() cannot be run}); $SQL = "LOCK TABLE foobar IN SHARE MODE NOWAIT"; eval { $safe->do("$SQL WITHERROR"); }; like($@, qr{at or near "WITHERROR"}, qq{Regexes passed to allow_regex() can be run}); $dbh->rollback(); eval { $safe->do("SET $SQL"); }; like($@, $NORUN, qq{Method allow_regex() matches with an anchor}); eval { $info = $safe->unallow_regex(); }; is($@, q{}, qq{Method unallow_regex() returns a list when given no arguments}); is_deeply($info, {qr{$regex1} => 1, qr{$regex2} => 0, qr{$regex3} => 0}, qq{Method unallow_regex() returns correct list}); eval { $safe->unallow_regex($regex1); }; like($@, qr{unallow_regex must be passed}, qq{Method unallow_regex() fails when given a string}); eval { $safe->unallow_regex([qr{$regex1}, qr{$regex1}]); }; like($@, qr{duplicate regexes}, qq{Method unallow_regex() fails when passed duplicate regexes}); eval { $info = $safe->unallow_regex(qr{$regex1}); }; is($@, q{}, qq{Method unallow_regex() works with a single regex}); is_deeply($info, {qr{$regex2} => 0, qr{$regex3} => 0}, qq{Method unallow_regex() returns correct list}); eval { $info = $safe->unallow_regex([qr{$regex2}, qr{$regex3}]); }; is($@, q{}, qq{Method unallow_regex() works with an arrayref argument}); is_deeply($info, {}, qq{Method unallow_regex() returns correct list}); eval { $safe->do("$SQL WITHERROR"); }; like($@, $NORUN, qq{Regexes passed to allow_regex() can be run}); $dbh->rollback(); # # Tests for the allow_attribute() and unallow_attributes() methods # eval { $info = $safe->allow_attribute(); }; is($@, q{}, qq{Method allow_attribute() returns a list when given no arguments}); is_deeply($info, {}, qq{Method allow_attribute() returns correct list}); eval { $safe->allow_attribute({foobar => 1}); }; like($@, qr{allow_attribute must be passed}, qq{Method allow_attribute() fails when passed a hashref}); eval { $safe->allow_attribute([qw(raiseerror printError RaiseError)]); }; like($@, qr{duplicate argument}, qq{Method allow_attribute() fails when passed duplicate attributes}); eval { $safe->allow_attribute('RaiseError PrintError RaiseError'); }; like($@, qr{duplicate argument}, qq{Method allow_attribute() fails when passed duplicate attributes}); eval { $safe->allow_attribute(['RaiseError','InsertError raiseError']); }; like($@, qr{duplicate argument}, qq{Method allow_attribute() fails when passed duplicate attributes}); eval { $safe->allow_attribute('RaiseError!'); }; like($@, qr{invalid argument}, qq{Method allow_attribute() fails when passed an invalid attribute}); eval { $info = $safe->allow_attribute('PrintError'); }; is($@, q{}, qq{Method allow_attribute() works with a single attribute}); is_deeply($info, {printerror => 0}, qq{Method allow_attribute() returns correct list}); eval { $info = $safe->allow_attribute(['RaiseError','PrintError ListError ']); }; is($@, q{}, qq{Method allow_attribute() works with an arrayref argument}); is_deeply($info, {printerror => 0, raiseerror => 0, listerror => 0}, qq{Method allow_attribute() returns correct list}); eval { $safe->{foobar}= 1; }; like($@, qr{Cannot change attribute}, qq{Attributes not passed to allow_attribute() cannot be changed}); eval { $safe->{PrintError} = 2; }; is($@, q{}, qq{Attributes passed to allow_attribute() can be run}); eval { $info = $safe->unallow_attribute(); }; is($@, q{}, qq{Method unallow_attribute() returns a list when given no arguments}); is_deeply($info, {printerror => 1, raiseerror => 0, listerror => 0}, qq{Method unallow_attribute() returns correct list}); eval { $safe->unallow_attribute(qr{foobar}); }; like($@, qr{unallow_attribute must be passed}, qq{Method unallow_attribute() fails when given a regex}); eval { $safe->unallow_attribute('raiseerror RaiseError'); }; like($@, qr{duplicate argument}, qq{Method unallow_attribute() fails when passed duplicate attributes}); eval { $safe->unallow_attribute(['printError',' PrintError']); }; like($@, qr{duplicate argument}, qq{Method unallow_attribute() fails when passed duplicate attributes}); eval { $safe->unallow_attribute(['listerror','listerror raiseerror']); }; like($@, qr{duplicate argument}, qq{Method unallow_attribute() fails when passed duplicate attributes}); eval { $info = $safe->unallow_attribute('listerror'); }; is($@, q{}, qq{Method unallow_attribute() works with a single attribute}); is_deeply($info, {printerror => 1, raiseerror => 0}, qq{Method unallow_attribute() returns correct list}); eval { $info = $safe->unallow_attribute([qw(printerror deleteError)]); }; is($@, q{}, qq{Method unallow_attribute() works with an arrayref argument}); is_deeply($info, {raiseerror => 0}, qq{Method unallow_attribute() returns correct list}); eval { $safe->{PrintError} = 0; }; like($@, qr{Cannot change attribute}, qq{Attributes passed to unallow_attribute() can no longer be run}); eval { $safe->allow_attribute('AutoCommit'); }; like($@, qr{Attribute AutoCommit cannot be changed}, qq{Attribute AutoCommit cannot be changed}); eval { $safe->{AutoCommit} = 1; }; like($@, qr{Cannot change attribute}, qq{Attribute AutoCommit cannot be changed}); eval { $safe->{AutoCommit} = 0; }; like($@, qr{Cannot change attribute}, qq{Attribute AutoCommit cannot be changed}); ## We should not be allowed to ever return internal attributes eval { $info = $safe->{dbixsafe_sdbh}; }; like($@, qr{Invalid access}, qq{Not allowed to read internal attributes}); eval { $safe->{dbixsafe_cdate} = 123; }; like($@, qr{Invalid access}, qq{Not allowed to write internal attributes}); ## Cheating with package switching should not work either ## no critic $main::err = ''; {no warnings; $DBIx::Safe::safe = $safe; package DBIx::Safe; eval { $DBIx::Safe::info = $safe->{dbixsafe_sdbh}; }; $main::err = $@; } package main; like($main::err, qr{Invalid access}, qq{Not allowed to read internal attributes}); is($DBIx::Safe::info, undef, qq{Using package trickery does not allow access to a raw database handle}); ## use critic # # Tests for the deny_regex() and undeny_regex() methods # $regex1 = q{LOCK TABLE foobar}; $regex2 = q{SELECT 456}; $regex3 = q{SELECT 789}; eval { $info = $safe->deny_regex(); }; is($@, q{}, qq{Method deny_regex() returns a list when given no arguments}); is_deeply($info, {}, qq{Method deny_regex() returns correct list}); eval { $safe->deny_regex({foobar => 1}); }; like($@, qr{deny_regex must be passed}, qq{Method deny_regex() fails when passed a hashref}); eval { $safe->deny_regex($regex1); }; like($@, qr{deny_regex must be passed}, qq{Method deny_regex() fails when passed a string}); eval { $safe->deny_regex([qr{$regex2}, qr{$regex2}]); }; like($@, qr{duplicate regex}, qq{Method deny_regex() fails when passed duplicate regexes}); eval { $safe->deny_regex([qr{$regex2}, $regex2]); }; like($@, qr{deny_regex must be passed}, qq{Method deny_regex() fails when passed an arrayref with a non-regex member}); eval { $info = $safe->deny_regex(qr{$regex1}); }; is($@, q{}, qq{Method deny_regex() works with a single regex}); is_deeply($info, {qr{$regex1} => 0}, qq{Method deny_regex() returns correct list}); eval { $info = $safe->deny_regex([qr{$regex1}, qr{$regex2}]); }; is($@, q{}, qq{Method deny_regex() works with an arrayref argument}); is_deeply($info, {qr{$regex1} => 0, qr{$regex2} => 0}, qq{Method deny_regex() returns correct list}); eval { $safe->do("SELECT 123"); }; is($@, q{}, qq{Method deny_regex() allows normal SQL to run}); eval { $safe->do("SELECT 456"); }; like($@, $FORBID, qq{Method deny_regex() restricts matching expressions from running}); eval { $safe->do("selECT 456"); }; is($@, q{}, qq{Method deny_regex() does not restrict case-sensitively by default}); $safe->deny_regex(qr{$regex2}i); eval { $safe->do("selECT 456"); }; like($@, $FORBID, qq{Method deny_regex() checks case-sensitively when asked to}); eval { $safe->do("SELECT 'selECT 456'"); }; like($@, $FORBID, qq{Method deny_regex() doe not anchor by default}); eval { $safe->do("SELECT 'selECT 456'"); }; like($@, $FORBID, qq{Method deny_regex() does not anchor by default}); $safe->deny_regex(qr{^$regex3}i); eval { $safe->do("SELECT 'SELECT 789'"); }; is($@, q{}, qq{Method deny_regex() allows anchoring of expressions}); eval { $info = $safe->undeny_regex(); }; is($@, q{}, qq{Method undeny_regex() returns a list when given no arguments}); is_deeply($info, {qr{$regex1} => 0, qr{$regex2} => 0, qr{$regex2}i => 0, qr{^$regex3}i => 0}, qq{Method undeny_regex() returns correct list}); eval { $safe->undeny_regex($regex1); }; like($@, qr{undeny_regex must be passed}, qq{Method undeny_regex() fails when given a string}); eval { $safe->undeny_regex([qr{$regex1}, qr{$regex1}]); }; like($@, qr{duplicate regexes}, qq{Method undeny_regex() fails when passed duplicate regexs}); eval { $safe->undeny_regex([qr{$regex2}, $regex2]); }; like($@, qr{undeny_regex must be passed}, qq{Method undeny_regex() fails when passed an arrayref with a non-regex member}); eval { $info = $safe->undeny_regex(qr{^$regex3}i); }; is($@, q{}, qq{Method undeny_regex() works with a single regex}); is_deeply($info, {qr{$regex1} => 0, qr{$regex2} => 0, qr{$regex2}i => 0}, qq{Method undeny_regex() returns correct list}); eval { $info = $safe->undeny_regex([qr{$regex1}, qr{$regex2}i]); }; is($@, q{}, qq{Method undeny_regex() works with an arrayref argument}); is_deeply($info, {qr{$regex2} => 0}, qq{Method undeny_regex() returns correct list}); eval { $safe->do("SELECT 789"); }; is($@, q{}, qq{Method undeny_regex() clears out entries, allowing statements to run}); # # Tests for transactional methods # eval { $safe->begin_work(); }; like($@, qr{not allowed}, qq{Method begin_work() does not work before being allowed}); eval { $safe->commit(); }; like($@, qr{not allowed}, qq{Method commit() does not work before being allowed}); eval { $safe->rollback(); }; like($@, qr{not allowed}, qq{Method rollback() does not work before being allowed}); $safe->allow_command('begin begin_work commit release rollback'); $dbh->{PrintError} = 0; eval { $safe->begin_work(); }; like($@, qr{in a transaction}, qq{Method begin_work() can be run when specifically allowed}); eval { $safe->commit(); }; is($@, q{}, qq{Method commit() can be run when specifically allowed}); eval { $safe->rollback(); }; is($@, q{}, qq{Method rollback() can be run when specifically allowed}); eval { $safe->do("COMMIT this"); }; like($@, qr{Cannot use}, qq{Cannot use "commit" in normal SQL}); eval { $safe->do("ROLLBACK that"); }; like($@, qr{Cannot use}, qq{Cannot use "rollback" in normal SQL}); eval { $safe->do("RELEASE me"); }; like($@, qr{Cannot use}, qq{Cannot use "release" in normal SQL}); eval { $safe->do("BEGIN again"); }; like($@, qr{Cannot use}, qq{Cannot use "begin" in normal SQL}); $safe->unallow_command('begin begin_work commit release rollback'); # # Tests for the do() method # eval { $safe->do("SELECT 123"); }; is($@, q{}, qq{Method do() works with allowed commands}); eval { $safe->do("SELECT 123; SELECT 345"); }; like($@, $NOMULTI, qq{Method do() fails with multiple statements}); $dbh->rollback(); eval { $safe->do("SELECT ?::text", 123); }; is($@, q{}, qq{Method do() works with allowed commands and placeholders}); eval { $safe->do("SELECT ?::text; SELECT 345", 123); }; like($@, $NOMULTI, qq{Multiple statements to do() with placeholders fail}); $dbh->rollback(); # # Test for the prepare() method # eval { $sth = $safe->prepare("SELECT 123::text"); }; is($@, q{}, qq{Method prepare() works with allowed commands}); eval { $sth = $safe->prepare("INSERT 123::text"); }; like($@, $NORUN, qq{Method prepare() fails with unallowed commands}); eval { $sth = $safe->prepare("SELECT 123::text ; LISTEN to_me "); }; like($@, $NOMULTI, qq{Method prepare() fails with multiple statements}); $dbh->rollback(); eval { $sth = $safe->prepare("SELECT ?::text", "123"); }; is($@, q{}, qq{Method prepare() works with allowed commands and placeholders}); eval { $sth = $safe->prepare("INSERT ?::text", "123"); }; like($@, $NORUN, qq{Method prepare() fails with unallowed commands and placeholders}); eval { $sth = $safe->prepare("SELECT ?::text ; LISTEN to_me ", "123"); }; like($@, $NOMULTI, qq{Method prepare() fails with multiple statements and placeholders}); $dbh->rollback(); $sth = $safe->prepare("SELECT 123::text"); isa_ok($sth, 'DBI::st', qq{Correct object is returned from method prepare()}); eval { $sth->execute(); }; is($@, q{}, qq{Handle returned by method prepare() can be executed}); $dbh->{RaiseError} = 0; $dbh->{PrintError} = 0; eval { $sth->execute(123); }; like($@, qr{when 0 are needed}, qq{Handle returned by method prepare() dies with invalid number of arguments}); $sth = $safe->prepare("SELECT ?::text"); eval { $sth->execute(456); }; is($@, q{}, qq{Handle returned by method prepare() with placeholders can be executed}); # # Tests of the various dbh 'utility' access methods # $SQL = "SELECT 1 AS id, 2, 3"; eval { $info = $safe->selectall_arrayref($SQL); }; is($@, q{}, qq{Method selectall_arrayref() works}); $expected = $dbh->selectall_arrayref($SQL); is_deeply($info, $expected, qq{Method selectall_arrayaref() returns correct information}); eval { $safe->selectall_arrayref("$SQL; $SQL"); }; like($@, $NOMULTI, qq{Method selectall_arrayaref() fails when sent multiple statements}); $dbh->rollback(); eval { $info = $safe->selectall_hashref($SQL,'id'); }; is($@, q{}, qq{Method selectall_hashref() works}); $expected = $dbh->selectall_hashref($SQL, 'id'); is_deeply($info, $expected, qq{Method selectall_hashref() returns correct information}); eval { $safe->selectall_hashref("$SQL;$SQL", 'id'); }; like($@, $NOMULTI, qq{Method selectall_hashref() fails when sent multiple statements}); $dbh->rollback(); eval { $info = $safe->selectcol_arrayref($SQL); }; is($@, q{}, qq{Method selectcol_arrayref() works}); $expected = $dbh->selectcol_arrayref($SQL); is_deeply($info, $expected, qq{Method selectcol_arrayref() returns correct information}); eval { $safe->selectcol_arrayref("$SQL;$SQL", 'id'); }; like($@, $NOMULTI, qq{Method selectcol_arrayref() fails when sent multiple statements}); $dbh->rollback(); eval { $info = $safe->selectrow_array($SQL); }; is($@, q{}, qq{Method selectrow_array() works}); $expected = $dbh->selectrow_array($SQL); is_deeply($info, $expected, qq{Method selectrow_array() returns correct information}); eval { $safe->selectrow_array("$SQL;$SQL", 'id'); }; like($@, $NOMULTI, qq{Method selectrow_array() fails when sent multiple statements}); $dbh->rollback(); eval { $info = $safe->selectrow_arrayref($SQL); }; is($@, q{}, qq{Method selectrow_arrayref() works}); $expected = $dbh->selectrow_arrayref($SQL); is_deeply($info, $expected, qq{Method selectrow_arrayref() returns correct information}); eval { $safe->selectrow_arrayref("$SQL;$SQL", 'id'); }; like($@, $NOMULTI, qq{Method selectrow_arrayref() fails when sent multiple statements}); $dbh->rollback(); eval { $info = $safe->selectrow_hashref($SQL); }; is($@, q{}, qq{Method selectrow_hashref() works}); $expected = $dbh->selectrow_hashref($SQL); is_deeply($info, $expected, qq{Method selectrow_hashref() returns correct information}); eval { $safe->selectrow_hashref("$SQL;$SQL", 'id'); }; like($@, $NOMULTI, qq{Method selectrow_hashref() fails when sent multiple statements}); $dbh->rollback(); # # Tests for the prepare_cached() method # eval { $safe->prepare_cached("SELECT 123::int"); }; like($@, qr{not supported yet}, qq{Method prepare_cached() fails to work}); # # Tests for read-only database handle methods # eval { $safe->quote(q{It's "hammer" time}); }; like($@, qr{Calling method 'quote' is not allowed}, qq{Method quote() does not work by default}); $safe->allow_command('quote'); eval { $info = $safe->quote(q{It's "hammer" time}); }; is($@, q{}, qq{Method quote() works}); is($info, qq{'It''s "hammer" time'}, qq{Method quote() returns the expected output}); $safe->unallow_command('quote'); eval { $safe->quote_identifier(q{It's "hammer" time}); }; like($@, qr{Calling method 'quote_identifier' is not allowed}, qq{Method quote_identifier() does not work by default}); $safe->allow_command('quote_identifier'); eval { $info = $safe->quote_identifier(q{It's "hammer" time}); }; is($@, q{}, qq{Method quote_identifier() works}); is($info, qq{"It's ""hammer"" time"}, qq{Method quote_identifier() returns the expected output}); $safe->unallow_command('quote_identifier'); # Throw an error on purpose eval { $safe->do("SELECT 1/0"); }; is($@, q{}, qq{SELECT 1/0 throws an error for future testing}); $dbh->rollback; eval { $safe->err; }; like($@, qr{Calling method 'err' is not allowed}, qq{Method err() does not work by default}); $safe->allow_command('err'); eval { $info = $safe->err; }; is($@, q{}, qq{Method err() did not return an error}); is_deeply($info, $dbh->err, qq{Method err() returns the correct value}); $safe->unallow_command('err'); eval { $safe->errstr; }; like($@, qr{Calling method 'errstr' is not allowed}, qq{Method errstr() does not work by default}); $safe->allow_command('errstr'); eval { $info = $safe->errstr; }; is($@, q{}, qq{Method errstr() did not return an error}); is_deeply($info, $dbh->errstr, qq{Method errstr() returns the correct value}); $safe->unallow_command('errstr'); eval { $safe->state; }; like($@, qr{Calling method 'state' is not allowed}, qq{Method state() does not work by default}); $safe->allow_command('state'); eval { $info = $safe->state; }; is($@, q{}, qq{Method state() did not return an error}); is_deeply($info, $dbh->state, qq{Method state() returns the correct value}); $safe->unallow_command('state'); ## Rollback our errors from above $dbh->rollback(); eval { $safe->can('execute'); }; like($@, qr{Calling method 'can' is not allowed}, qq{Method can() does not work by default}); $safe->allow_command('can'); eval { $info = $safe->can('execute'); }; is($@, q{}, qq{Method can() did not return an error}); is_deeply($info, $dbh->can('execute'), qq{Method can() returns the correct value}); $safe->allow_command('can'); eval { $safe->parse_trace_flag(1); }; like($@, qr{Calling method 'parse_trace_flag' is not allowed}, qq{Method parse_trace_flag() does not work by default}); $safe->allow_command('parse_trace_flag'); eval { $info = scalar $safe->parse_trace_flag(1); }; is($@, q{}, qq{Method parse_trace_flag() did not return an error}); my $expected = $dbh->parse_trace_flag(1); is(defined $info ? $info : "UNDEF", defined $expected ? $expected : "UNDEF", qq{Method parse_trace_flag() returns the correct value}); $safe->unallow_command('can'); eval { $safe->parse_trace_flags(3); }; like($@, qr{Calling method 'parse_trace_flags' is not allowed}, qq{Method parse_trace_flags() does not work by default}); $safe->allow_command('parse_trace_flags'); eval { $info = $safe->parse_trace_flags(3); }; is($@, q{}, qq{Method parse_trace_flags() did not return an error}); is_deeply($info, $dbh->parse_trace_flags(3), qq{Method parse_trace_flags() returns the correct value}); $safe->unallow_command('parse_trace_flags'); eval { $safe->data_sources(); }; like($@, qr{no}, qq{Method data_sources() does not run by default}); $safe->allow_command('data_sources'); eval { $info = $safe->data_sources(); }; is($@, q{}, qq{Method data_sources() works once allowed}); $expected = $dbh->data_sources; is_deeply($info, $expected, qq{Method data_sources() returns the correct value}); $safe->unallow_command('data_sources'); eval { $safe->last_insert_id(1,2,3,4); }; like($@, qr{Calling method 'last_insert_id' is not allowed}, qq{Method last_insert_id() does not run by default}); $safe->allow_command('last_insert_id'); eval { $safe->last_insert_id(1,2,3,4); }; unlike($@, qr{Calling method 'last_insert_id' is not allowed}, qq{Method last_insert_id() works once allowed}); $safe->unallow_command('last_insert_id'); eval { $safe->table_info(1,2,3,4); }; like($@, qr{Calling method 'table_info' is not allowed}, qq{Method table_info() does not run by default}); $safe->allow_command('table_info'); eval { $safe->table_info(1,2,3,4); }; unlike($@, qr{Calling method 'table_info' is not allowed}, qq{Method table_info() works once allowed}); $safe->unallow_command('table_info'); eval { $safe->column_info(1,2,3,4); }; like($@, qr{Calling method 'column_info' is not allowed}, qq{Method column_info() does not run by default}); $safe->allow_command('column_info'); eval { $safe->column_info(1,2,3,4); }; unlike($@, qr{Calling method 'column_info' is not allowed}, qq{Method column_info() works once allowed}); $safe->unallow_command('column_info'); eval { $safe->primary_key_info(1,2,3,4); }; like($@, qr{Calling method 'primary_key_info' is not allowed}, qq{Method primary_key_info() does not run by default}); $safe->allow_command('primary_key_info'); eval { $safe->primary_key_info(1,2,3,4); }; unlike($@, qr{Calling method 'primary_key_info' is not allowed}, qq{Method primary_key_info() works once allowed}); $safe->unallow_command('primary_key_info'); eval { $safe->ping; }; like($@, qr{Calling method 'ping' is not allowed}, qq{Method ping() does not run by default}); $safe->allow_command('ping'); eval { $info = $safe->ping; }; is($@, q{}, qq{Method ping() works once allowed}); is_deeply($info, $dbh->ping, qq{Method 'ping' returns the correct value}); $safe->unallow_command('ping'); eval { $safe->get_info(17); }; like($@, qr{Calling method 'get_info' is not allowed}, qq{Method get_info() does not run by default}); $safe->allow_command('get_info'); eval { $info = $safe->get_info(17); }; is($@, q{}, qq{Method get_info() works once allowed}); is_deeply($info, $dbh->get_info(17), qq{Method 'get_info' returns the correct value}); $safe->unallow_command('get_info'); # # Tests for read/write database handle methods # eval { $info = $safe->trace; }; is($@, q{}, qq{Method trace() did not return an error}); is_deeply($info, $dbh->trace, qq{Method trace() returns the correct value}); eval { $safe->trace(0); }; like($@, qr{Calling method 'trace' with arguments is not allowed}, qq{Method trace() not allowed by default}); $safe->allow_command('trace'); eval { $safe->trace(0); }; is($@, q{}, qq{Method trace() allowed after passed to allow_command}); eval { $info = $safe->trace; }; is($@, q{}, qq{Method trace() did not return an error}); is_deeply($info, $dbh->trace, qq{Method trace() returns the correct value}); $safe->unallow_command('trace'); # # Tests for write-only database handle methods # eval { $safe->trace_msg('DBIx::Safe testing'); }; like($@, qr{Calling method 'trace_msg' is not allowed}, qq{Method trace_msg() is not allowed by default}); $safe->allow_command('trace_msg'); eval { $safe->trace_msg('DBIx::Safe testing'); }; is($@, q{}, qq{Method trace_msg() allowed after passed to allow_command}); $safe->unallow_command('trace_msg'); eval { $safe->func('DBIx::Safe func testing'); }; like($@, qr{Calling method 'func' is not allowed}, qq{Method func() is not allowed by default}); $safe->allow_command('func'); eval { $safe->func('DBIx::Safe testing'); }; unlike($@, qr{Calling method 'func' is not allowed}, qq{Method func() allowed after passed to allow_command}); $safe->unallow_command('func'); $dbh->rollback(); # # Test of Postgres pg_ table restrictions # SKIP: { skip 'Postgres specific tests', 9 if $dbtype ne 'Pg'; ## Recipe for disallowing changes to the system tables: $safe->deny_regex(qr{/\*}); ## No SQL comments $safe->deny_regex(qr{^update\s+["\s]*pg_}i); $safe->deny_regex(qr{^insert\s+into\s+["\s]*pg_}i); $safe->deny_regex(qr{^delete\s+from\s+["\s]*pg_}i); $safe->allow_command("insert update delete"); eval { $safe->do("UPDATE pg_class SET nefarious=1"); }; like($@, $FORBID, qq{Method do() fails when updating system tables}); eval { $safe->do("INSERT INTO pg_class(foobar) VALUES (1)"); }; like($@, $FORBID, qq{Method do() fails when inserting into system tables}); eval { $safe->do("DELETE FROM pg_class WHERE wontwork=1"); }; like($@, $FORBID, qq{Method do() fails when deleting from system tables}); eval { $safe->do(qq{UPDATE "pg_class" SET nefarious=1}); }; like($@, $FORBID, qq{Method do() fails when updating system tables using quotes}); eval { $safe->do(qq{UPDATE pg_catalog.pg_class SET nefarious=1}); }; like($@, $FORBID, qq{Method do() fails when updating system tables using schema}); eval { $safe->do(qq{UPDATE "pg_catalog.pg_class" SET nefarious=1}); }; like($@, $FORBID, qq{Method do() fails when updating system tables using schema and quotes}); eval { $safe->do(qq{UPDATE "pg_catalog"."pg_class" SET nefarious=1}); }; like($@, $FORBID, qq{Method do() fails when updating system tables using schema and quotes}); eval { $safe->do(qq{ DELETE FROM\t"pg_class" WHERE wontwork=1}); }; like($@, $FORBID, qq{Method do() fails when updating system tables using funky whitespace}); eval { $safe->do(qq{UPDATE /* comment */ "pg_catalog"."pg_class" SET nefarious=1}); }; like($@, $FORBID, qq{Method do() fails when updating system tables using comments}); } ## end Postgres specific tests DBIx-Safe-1.2.5/t/01safe.t0000644000175000017500000000035010704727220013321 0ustar greggreg#!/usr/bin/perl -- -*-cperl-*- use strict; use warnings; use Test::More tests => 1; use Data::Dumper; eval { require DBIx::Safe; }; $@ and BAIL_OUT qq{Could not load the DBIx::Safe module: $@}; pass("DBIx::Safe module loaded"); DBIx-Safe-1.2.5/MANIFEST0000644000175000017500000000024210704725735012754 0ustar greggregSIGNATURE Safe.pm Safe.pm.html README INSTALL LICENSE TODO Changes META.yml MANIFEST MANIFEST.SKIP Makefile.PL .perlcriticrc t/01safe.t t/02perlcritic.t t/03db.t DBIx-Safe-1.2.5/TODO0000644000175000017500000000034210702543676012314 0ustar greggreg Possible future ideas for DBIx::Safe: * Support for prepare_cached * Support for errstr * Better trace read/write separation * Group privs e.g. $safe->allow_readonly_attributes * Allow peronalized messages via deny_regex DBIx-Safe-1.2.5/MANIFEST.SKIP0000644000175000017500000000013110702543676013516 0ustar greggreg~$ ^# ^Makefile$ ^Makefile\.old$ ^blib ^pm_to_blib$ \.tar\.gz$ ^tmp/ .git/ outgoingmail. DBIx-Safe-1.2.5/INSTALL0000644000175000017500000000001610702543676012653 0ustar greggregmake install DBIx-Safe-1.2.5/Makefile.PL0000644000175000017500000000163710704731351013575 0ustar greggreguse 5.008003; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'DBIx::Safe', VERSION_FROM => 'Safe.pm', PREREQ_PM => { DBD::Pg => 1.49, DBI => 1.49, Test::Simple => 0.30, Test::More => 0.61, Test::Harness => 2.03, }, ABSTRACT => 'Safe wrapper to DBI interface', AUTHOR => 'Greg Sabino Mullane ', NO_META => 1, clean => { FILES => '*~ *.tmp outgoingmail.*' }, ); package MY; sub manifypods { my $after = "\t \$(NOECHO) pod2html Safe.pm > Safe.pm.html\n\t\$(NOECHO) \$(RM_F) pod*.tmp pm_to_blib\n"; $after .= qq{\t\$(NOECHO) \$(PERL) -pi -e "s///" Safe.pm.html\n}; $after .= qq{\t\$(NOECHO) \$(ECHO) Created Safe.pm.html\n}; return shift->SUPER::manifypods(@_) . $after; } DBIx-Safe-1.2.5/SIGNATURE0000644000175000017500000000300010704732165013075 0ustar greggregThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: RIPEMD160 SHA1 836cb5e326f3d9cfc0008dfce009e674c0d27cf7 .perlcriticrc SHA1 0768f0bdd9ae1297f7755a995124a7c32bc33021 Changes SHA1 12f37cbc7225ed7d23fd859ec025ab8d759eff3c INSTALL SHA1 c811e5ddfc5b995c1d73069b0172c7d4b4799338 LICENSE SHA1 782ee79322a464d22505171b15b172dbb61aae9c MANIFEST SHA1 afa3fac09128e98e9a0377fc70e005f63852caf6 MANIFEST.SKIP SHA1 c0aaf0bd0a19bb6bd4718c8ea2089e976e9e3ea2 META.yml SHA1 0695dea17c3ac8cc3f6baabe74ac6a91493f872f Makefile.PL SHA1 d7abd7ebe5a05b9f61e474a851cfb013bb301e44 README SHA1 583615078d83d52526e28e422de342b9364206bd Safe.pm SHA1 c7e84b6e2e25d3c505c2c1155d2c5c4dc8e0c718 Safe.pm.html SHA1 8cb0df3893f722cae9d0466806bf733926b71c2f TODO SHA1 7916f3b998ac39f012db5a74b5a8e5e55c76cdb2 t/01safe.t SHA1 35436c9c7ae76cd0e56b23ecc6921486a2cbe269 t/02perlcritic.t SHA1 9068bfa2c4c17f31c8b3fac1cc194dc611ae7f48 t/03db.t -----BEGIN PGP SIGNATURE----- iD8DBQFHE7R1vJuQZxSWSsgRA+uuAKC9ZyTwDY49VUP4tpsWzBNtpDUoygCeLKCO yDVtEWrrWWCq+0V/xTxWSd8= =7PR2 -----END PGP SIGNATURE----- DBIx-Safe-1.2.5/README0000644000175000017500000000156610703527341012505 0ustar greggreg DBIx::Safe - safer access to databases via DBI DESCRIPTION: ------------ This is version 1.2.5 of DBIx::Safe COPYRIGHT: ---------- Copyright (c) 2007 Greg Sabino Mullane This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.3 or, at your option, any later version of Perl 5 you may have available. REQUIREMENTS: ------------- build, test, and install Perl 5 (at least 5.8.3) build, test, and install Postgres (at least 7.4) build, test, and install the DBI module (at least 1.42) build, test, and install the DBD::Pg module (at least 1.48) INSTALLATION: ------------- To install this module type the following, making sure that DBI_DSN and DBI_USER are set properly first: perl Makefile.PL make make test make install DBIx-Safe-1.2.5/LICENSE0000644000175000017500000000243410702543676012635 0ustar greggregCopyright (c) 2005, 2006, 2007 Greg Sabino Mullane . All right reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.