CGI-Info
view release on metacpan or search on metacpan
Remove most calls to substr
Added Mediatoolkitbot as a robot
Added NetcraftSurveyAgent as a robot
Added Expanse as a robot
Added Bytespider as a robot
Added t/pod-synopsis.t
Refactored t/unused.t and t/10-compile.t
Fixed Github Actions on Alpine Linux, FreeBSD and OpenBSD
Label AmazonBot as a search engine
Block directory traversal attacks
Set HTTP status to 403 on blocked attacks
Catch another SQL injection attempt
0.74 Wed Jan 4 22:16:12 EST 2023
Added python-requests/2.27.1 as a robot
Use latest Github Actions environment
Support Sec-CH-UA-Mobile
Calling new on an object now returns a clone rather than setting the defaults in the new object
0.73 Fri Oct 29 07:32:37 EDT 2021
Attempt to fix https://www.cpantesters.org/cpan/report/6db47260-389e-11ec-bc66-57723b537541
lib/CGI/Info.pm view on Meta::CPAN
($value =~ /\w*((\%27)|(\'))((\%6F)|o|(\%4F))((\%72)|r|(\%52))/ix) ||
($value =~ /((\%27)|(\'))union/ix) ||
($value =~ /select[[a-z]\s\*]from/ix) ||
($value =~ /\sAND\s1=1/ix) ||
($value =~ /\sOR\s.+\sAND\s/) ||
($value =~ /\/\*\*\/ORDER\/\*\*\/BY\/\*\*/ix) ||
($value =~ /\/AND\/.+\(SELECT\//) || # United/**/States)/**/AND/**/(SELECT/**/6734/**/FROM/**/(SELECT(SLEEP(5)))lRNi)/**/AND/**/(8984=8984
($value =~ /exec(\s|\+)+(s|x)p\w+/ix)) {
$self->status(403);
if($ENV{'REMOTE_ADDR'}) {
$self->_warn($ENV{'REMOTE_ADDR'} . ": SQL injection attempt blocked for '$value'");
} else {
$self->_warn("SQL injection attempt blocked for '$value'");
}
return;
}
if(my $agent = $ENV{'HTTP_USER_AGENT'}) {
if(($agent =~ /SELECT.+AND.+/) || ($agent =~ /ORDER BY /) || ($agent =~ / OR NOT /) || ($agent =~ / AND \d+=\d+/) || ($agent =~ /THEN.+ELSE.+END/) || ($agent =~ /.+AND.+SELECT.+/) || ($agent =~ /\sAND\s.+\sAND\s/)) {
$self->status(403);
if($ENV{'REMOTE_ADDR'}) {
$self->_warn($ENV{'REMOTE_ADDR'} . ": SQL injection attempt blocked for '$agent'");
} else {
$self->_warn("SQL injection attempt blocked for '$agent'");
}
return 1;
}
}
if(($value =~ /((\%3C)|<)((\%2F)|\/)*[a-z0-9\%]+((\%3E)|>)/ix) ||
($value =~ /((\%3C)|<)[^\n]+((\%3E)|>)/i) ||
($orig_value =~ /((\%3C)|<)((\%2F)|\/)*[a-z0-9\%]+((\%3E)|>)/ix) ||
($orig_value =~ /((\%3C)|<)[^\n]+((\%3E)|>)/i)) {
$self->status(403);
$self->_warn("XSS injection attempt blocked for '$value'");
return;
}
if($value =~ /mustleak\.com\//) {
$self->status(403);
$self->_warn("Blocked mustleak attack for '$key'");
return;
}
if($value =~ /\.\.\//) {
$self->status(403);
$self->_warn("Blocked directory traversal attack for '$key'");
return;
}
}
if(length($value) > 0) {
# Don't add if it's already there
if($FORM{$key} && ($FORM{$key} ne $value)) {
$FORM{$key} .= ",$value";
} else {
$FORM{$key} = $value;
}
lib/CGI/Info.pm view on Meta::CPAN
unless($remote && $agent) {
# Probably not running in CGI - assume real person
return 0;
}
# See also params()
if(($agent =~ /SELECT.+AND.+/) || ($agent =~ /ORDER BY /) || ($agent =~ / OR NOT /) || ($agent =~ / AND \d+=\d+/) || ($agent =~ /THEN.+ELSE.+END/) || ($agent =~ /.+AND.+SELECT.+/) || ($agent =~ /\sAND\s.+\sAND\s/)) {
$self->status(403);
$self->{is_robot} = 1;
if($ENV{'REMOTE_ADDR'}) {
$self->_warn($ENV{'REMOTE_ADDR'} . ": SQL injection attempt blocked for '$agent'");
} else {
$self->_warn("SQL injection attempt blocked for '$agent'");
}
return 1;
}
if($agent =~ /.+bot|axios\/1\.6\.7|bytespider|ClaudeBot|msnptc|CriteoBot|is_archiver|backstreet|linkfluence\.com|spider|scoutjet|gingersoftware|heritrix|dodnetdotcom|yandex|nutch|ezooms|plukkie|nova\.6scan\.com|Twitterbot|adscanner|Go-http-client|py...
$self->{is_robot} = 1;
return 1;
}
my $key = "$remote/$agent";
lib/CGI/Info.pm view on Meta::CPAN
'http://7makemoneyonline.com',
'http://anticrawler.org',
'http://baixar-musicas-gratis.com',
'http://descargar-musica-gratis.net',
# Mine
'http://www.seokicks.de/robot.html',
);
$referrer =~ s/\\/_/g;
if(($referrer =~ /\)/) || (List::Util::any { $_ =~ /^$referrer/ } @crawler_lists)) {
$self->_debug("is_robot: blocked trawler $referrer");
if($self->{cache}) {
$self->{cache}->set($key, 'robot', '1 day');
}
$self->{is_robot} = 1;
return 1;
}
}
if(defined($remote) && $self->{cache}) {
t/30-basics.t view on Meta::CPAN
subtest 'should block SQL injection attempts' => sub {
mock_env({
GATEWAY_INTERFACE => 'CGI/1.1',
REQUEST_METHOD => 'GET',
QUERY_STRING => 'id=1%27%20OR%201=1--'
}, sub {
my $info = CGI::Info->new(allow => { id => qr/^\d+$/ });
my $params = $info->params();
is $info->status, 422, 'Status 422 on SQL injection';
ok !defined $params->{id}, 'Blocked malicious parameter';
});
};
subtest 'should handle multipart form uploads' => sub {
mock_env({
GATEWAY_INTERFACE => 'CGI/1.1',
REQUEST_METHOD => 'POST',
CONTENT_TYPE => 'multipart/form-data; boundary=----boundary',
CONTENT_LENGTH => 1000
}, sub {
t/is_robot.t view on Meta::CPAN
cache => $cache,
]);
$i->set_logger(MyLogger->new());
ok($i->is_robot() == 1);
cmp_ok($i->status(), '==', 200, 'Default HTTP status is 200');
$ENV{'HTTP_USER_AGENT'} = 'Mozilla/5.0 (Windows; U; Windows NT 5.1; zh) AppleWebKit/522.11.3 (KHTML, like Gecko) Version/3.0 Safari/522.11.3\") OR EXTRACTVALUE(2534,CONCAT(0x5c,0x7170767871,(SELECT (ELT(2534=2534,1))),0x716b627171)) AND (\"OqXr\"=\"...
delete $ENV{'HTTP_REFERER'};
$i = new_ok('CGI::Info');
ok($i->is_robot());
cmp_ok($i->status(), '==', 403, 'Check HTTP_USER_AGENT SQL Injection is blocked');
}
# ok($i->as_string() eq 'foo=<\;script>\;alert(hello)<\;/script>\;');
ok(!defined($i->param('foo')));
ok($i->as_string() eq '');
$ENV{'QUERY_STRING'} = 'foo=&fred=wilma&foo=bar';
$i = new_ok('CGI::Info');
ok($i->param('foo', logger => MyLogger->new()) eq 'bar');
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')));
};
@ARGV = ('foo=bar', 'fred=wilma' );
$i = new_ok('CGI::Info');
%p = %{$i->params(logger => MyLogger->new())};
ok($p{fred} eq 'wilma');
ok($i->as_string() eq 'foo=bar; fred=wilma');
ok(!$i->is_mobile());
@ARGV= ('file=/../../../../etc/passwd%00');
$i = new_ok('CGI::Info');
dies_ok { %p = %{$i->params()} }; # Warns because logger isn't set
like($@, qr/Blocked directory traversal attack/);
diag(Data::Dumper->new([$i->messages()])->Dump()) if($ENV{'TEST_VERBOSE'});
like(
$i->messages()->[1]->{'message'},
qr/^Blocked directory traversal attack for 'file'/,
'Warning generated for disallowed parameter'
);
cmp_ok($i->messages()->[1]->{'level'}, 'eq', 'warn');
like($i->messages_as_string(), qr/Blocked directory traversal attack/, 'messages_as_string works');
@ARGV= ('file=/etc/passwd%00');
$i = new_ok('CGI::Info');
lives_ok { %p = %{$i->params()}; };
like($p{'file'}, qr/passwd$/, 'strip NUL byte poison');
@ARGV = ('--mobile', 'foo=bar', 'fred=wilma' );
$i = new_ok('CGI::Info');
%p = %{$i->params()};
ok($p{fred} eq 'wilma');
{
package MockLogger;
sub new { bless { }, shift }
sub trace { }
sub warn { shift; $mess = (ref($_[0]) eq 'ARRAY') ? join(' ', @{$_[0]}) : join(' ' , @_) }
}
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');
cmp_ok($info->status(), '==', 403, 'SQL injection causes HTTP code 403');
}
$ENV{'QUERY_STRING'} = 'country=/etc/passwd&page=by_location';
$i = new_ok('CGI::Info');
my $allow = {
'entry' => undef,
'country' => qr/^[A-Z\s]+$/i, # Must start with a letter
subtest 'SQL Injection Detection' => sub {
local %ENV = (
GATEWAY_INTERFACE => 'CGI/1.1',
REQUEST_METHOD => 'GET',
QUERY_STRING => 'username=nigel%27+OR+%271%27%3D%271',
);
$info = new_ok('CGI::Info');
my $params = $info->params();
ok(!defined $params, 'SQL injection attempt blocked');
is($info->status(), 403, 'Status set to 403 Forbidden');
$ENV{'QUERY_STRING'} = 'page=by_location&county=CA&country=United%2F%2A%2A%2FStates%29%2F%2A%2A%2FAND%2F%2A%2A%2F%28SELECT%2F%2A%2A%2F6734%2F%2A%2A%2FFROM%2F%2A%2A%2F%28SELECT%28SLEEP%285%29%29%29lRNi%29%2F%2A%2A%2FAND%2F%2A%2A%2F%288984%3D8984';
$info = new_ok('CGI::Info');
$params = $info->params();
ok(!defined $params, 'SQL injection attempt blocked 2');
is($info->status(), 403, 'Status set to 403 Forbidden');
};
subtest 'XSS Sanitization' => sub {
local %ENV = (
GATEWAY_INTERFACE => 'CGI/1.1',
REQUEST_METHOD => 'GET',
QUERY_STRING => 'comment=<script>alert("xss")</script>',
);
$info = new_ok('CGI::Info');
my $params = $info->params();
# is(
# $params->{comment},
# '<script>alert("xss")</script>',
# 'XSS content sanitized'
# );
ok(!defined $params, 'XSS injection attempt blocked');
is($info->status(), 403, 'Status set to 403 Forbidden');
};
subtest 'Directory Traversal Prevention' => sub {
local %ENV = (
GATEWAY_INTERFACE => 'CGI/1.1',
REQUEST_METHOD => 'GET',
QUERY_STRING => 'file=../../etc/passwd',
);
$info = new_ok('CGI::Info');
my $params = $info->params();
ok(!defined $params, 'Directory traversal attempt blocked');
is($info->status(), 403, 'Status set to 403 Forbidden');
};
subtest 'Upload Directory Validation' => sub {
local %ENV = (
GATEWAY_INTERFACE => 'CGI/1.1',
REQUEST_METHOD => 'POST',
CONTENT_TYPE => 'multipart/form-data; boundary=12345',
CONTENT_LENGTH => 100,
C_DOCUMENT_ROOT => $upload_dir,
( run in 0.542 second using v1.01-cache-2.11-cpan-49f99fa48dc )