Remember warnings in the warnings array - added warnings() method

Changes

@@ -2,6 +2,7 @@ Revision history for CGI-Info
 
 0.86
 	Ensure correct message is logged on SQL injection attempt
+	Remember warnings in the warnings array - added warnings() method
 
 0.85	Sun Nov 17 09:49:52 EST 2024
 	Send back HTTP code 422 when argument fails "allow"

lib/CGI/Info.pm

@@ -863,6 +863,8 @@ sub _warn {
 	}
 	# return if($self eq __PACKAGE__);  # Called from class method
 
+	push @{$self->{'warnings'}}, { warning => $warning };
+
 	if($self->{syslog}) {
 		require Sys::Syslog;
 
@@ -1737,6 +1739,19 @@ sub status
 	return $self->{status} || 200;
 }
 
+=head2 warnings
+
+Returns the warnings that the object has generated
+
+=cut
+
+sub warnings
+{
+	my $self = shift;
+
+	return $self->{'warnings'};
+}
+
 =head2 set_logger
 
 Sometimes you don't know what the logger is until you've instantiated the class.

t/param.t

@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use Test::Most tests => 33;
+use Test::Most tests => 40;
 use Test::NoWarnings;
 use lib 't/lib';
 use MyLogger;
@@ -12,6 +12,48 @@ BEGIN {
 }
 
 PARAM: {
+	# Initial sanity tests
+	{
+		# Preserve the current %ENV, so changes are local to this subtest
+		local %ENV = %ENV;
+
+		$ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
+		$ENV{'REQUEST_METHOD'} = 'GET';
+		$ENV{'QUERY_STRING'} = 'foo=bar&baz=qux';
+		my $mess = 'mess is undefined';
+
+		{
+			package MockLogger;
+
+			sub new { bless { }, shift }
+			sub trace { }
+			sub debug { }
+			sub warn { shift; $mess = join(' ' , @_) }
+		}
+
+		my $obj = CGI::Info->new(
+			allow => { foo => undef, baz => undef },
+			logger => MockLogger->new()
+		);
+
+		is_deeply($obj->param, { foo => 'bar', baz => 'qux' }, 'No arguments returns all params');
+
+		is($obj->param('foo'), 'bar', 'Fetching allowed parameter "foo"');
+
+		is($obj->param('baz'), 'qux', 'Fetching allowed parameter "baz"');
+
+		is($obj->param('invalid'), undef, 'Fetching disallowed parameter "invalid" returns undef');
+		like(
+			$obj->warnings()->[0]->{'warning'},
+			qr/param: invalid isn't in the allow list/,
+			'Warning generated for disallowed parameter'
+		 );
+
+		delete $ENV{'QUERY_STRING'};
+		$obj = CGI::Info->new();
+		is($obj->param('foo'), undef, 'No params set, fetching "foo" returns undef');
+	};
+
 	$ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
 	$ENV{'REQUEST_METHOD'} = 'GET';
 	$ENV{'QUERY_STRING'} = 'foo=bar';
@@ -66,6 +108,18 @@ PARAM: {
 	ok($i->param('fred') eq 'wilma');
 	ok($i->as_string() eq 'foo=bar;fred=wilma');
 
+	subtest 'SQL injection is blocked' => sub {
+		# Preserve the current %ENV, so changes are local to this subtest
+		local %ENV = %ENV;
+
+		$ENV{'REQUEST_METHOD'} = 'GET';
+		$ENV{'QUERY_STRING'} = 'nan=lost&redir=-8717%22%20OR%208224%3D6013--%20ETLn';
+
+		my $info = new_ok('CGI::Info');
+		ok(!defined($info->param('nan')));
+		ok(!defined($info->param('redir')));
+	};
+
 	subtest 'Test GET' => sub {
 		# Preserve the current %ENV, so changes are local to this subtest
 		local %ENV = %ENV;
@@ -101,5 +155,6 @@ PARAM: {
 		is($info->name(), 'Jane', 'name parameter is correct with AUTOLOAD');
 
 		close $fh
-	}
+	};
+
 }

t/params.t

@@ -517,7 +517,7 @@ EOF
 			sub warn { shift; $mess = join(' ' , @_) }
 		}
 
-		my $info = new_ok('CGI::Info' => );
+		my $info = new_ok('CGI::Info');
 		my $params = $info->params(logger => MockLogger->new());
 		like($mess, qr/SQL injection attempt blocked/, 'Correct message when blocking SQL injection');