CGI-Info
view release on metacpan or search on metacpan
t/integration.t view on Meta::CPAN
# ============================================================
# 9. Browser detection + params in same session
# ============================================================
subtest 'mobile browser: browser_type, is_mobile, params all consistent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (iPhone; CPU iPhone OS 15_0 like Mac OS X)';
$ENV{REMOTE_ADDR} = '1.2.3.4';
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'view=compact&page=1';
my $info = CGI::Info->new();
ok($info->is_mobile(), 'is_mobile() true for iPhone');
ok(!$info->is_tablet(), 'is_tablet() false for iPhone');
is($info->browser_type(), 'mobile', 'browser_type() is mobile');
ok(!$info->is_robot(), 'is_robot() false for real user');
ok(!$info->is_search_engine(), 'is_search_engine() false for iPhone');
my $params = $info->params();
is($params->{view}, 'compact', 'params parsed correctly alongside mobile detection');
is($params->{page}, '1', 'page param parsed');
};
subtest 'tablet browser: is_tablet, is_mobile, browser_type consistent' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (iPad; CPU OS 15_0 like Mac OS X)';
$ENV{REMOTE_ADDR} = '1.2.3.4';
my $info = CGI::Info->new();
ok($info->is_tablet(), 'is_tablet() true for iPad');
ok($info->is_mobile(), 'is_mobile() true for iPad (tablets are mobile)');
is($info->browser_type(), 'mobile', 'browser_type() mobile for tablet');
};
subtest 'robot browser: is_robot, browser_type, params blocked on SQL UA' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'ClaudeBot/1.0 (+http://www.anthropic.com)';
$ENV{REMOTE_ADDR} = '1.2.3.4';
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'q=test';
my $info = CGI::Info->new();
ok($info->is_robot(), 'is_robot() true for ClaudeBot');
ok($info->is_ai(), 'is_ai() true for ClaudeBot');
is($info->browser_type(), 'ai', 'browser_type() is ai for AI crawler');
ok(!$info->is_mobile(), 'is_mobile() false for robot');
ok(!$info->is_tablet(), 'is_tablet() false for robot');
# params() should still work for a robot (it only blocks on bad content)
my $params = $info->params();
ok(!defined($params) || defined($params->{q}),
'params accessible for robot with clean query');
};
subtest 'desktop browser: browser_type web, not mobile/tablet/robot' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 Chrome/120';
$ENV{REMOTE_ADDR} = '1.2.3.4';
my $info = CGI::Info->new();
ok(!$info->is_mobile(), 'desktop is not mobile');
ok(!$info->is_tablet(), 'desktop is not tablet');
ok(!$info->is_robot(), 'desktop is not robot');
is($info->browser_type(), 'web', 'desktop browser_type is web');
};
# ============================================================
# 10. Stateful: --mobile/--robot/--tablet/--search-engine ARGV flags
# Each flag sets the appropriate state AND params() still works
# ============================================================
subtest 'ARGV --mobile flag: is_mobile true, params still parsed' => sub {
reset_env();
local @ARGV = ('--mobile', 'section=news', 'limit=10');
my $info = CGI::Info->new();
$info->params();
ok($info->is_mobile(), '--mobile sets is_mobile');
my $p = $info->params();
is($p->{section}, 'news', 'section param parsed after --mobile');
is($p->{limit}, '10', 'limit param parsed after --mobile');
};
subtest 'ARGV --robot flag: is_robot true, browser_type robot' => sub {
reset_env();
local @ARGV = ('--robot');
my $info = CGI::Info->new();
$info->params();
ok($info->is_robot(), '--robot sets is_robot');
is($info->browser_type(), 'robot', 'browser_type robot after --robot');
};
subtest 'ARGV --tablet flag: is_tablet true, is_mobile still works' => sub {
reset_env();
local @ARGV = ('--tablet', 'view=grid');
my $info = CGI::Info->new();
my $p = $info->params();
ok($info->is_tablet(), '--tablet sets is_tablet');
is($p->{view}, 'grid', 'view param parsed after --tablet');
};
subtest 'ARGV --search-engine flag: is_search_engine true' => sub {
reset_env();
local @ARGV = ('--search-engine');
my $info = CGI::Info->new();
$info->params();
ok($info->is_search_engine(), '--search-engine sets is_search_engine');
is($info->browser_type(), 'search', 'browser_type search after flag');
};
# ============================================================
# 11. Site details: host_name, domain_name, cgi_host_url, protocol consistent
# ============================================================
subtest 'site details: all methods consistent for http://www.example.com' => sub {
reset_env();
$ENV{HTTP_HOST} = 'www.example.com';
$ENV{SERVER_PROTOCOL} = 'HTTP/1.1';
my $info = CGI::Info->new();
t/integration.t view on Meta::CPAN
$ENV{HTTP_USER_AGENT} = 'Googlebot/2.1 (+http://www.google.com/bot.html)';
$ENV{REMOTE_ADDR} = '66.249.66.1';
$ENV{HTTP_HOST} = 'www.example.com';
$ENV{SERVER_PROTOCOL} = 'HTTP/1.1';
$ENV{SCRIPT_FILENAME} = '/var/www/cgi-bin/search.cgi';
$ENV{SCRIPT_NAME} = '/cgi-bin/search.cgi';
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = '';
my $info = CGI::Info->new();
# Site identity
is($info->host_name(), 'www.example.com', 'host_name correct');
is($info->domain_name(), 'example.com', 'domain_name correct');
is($info->protocol(), 'http', 'protocol correct');
# Script identity
is($info->script_name(), 'search.cgi', 'script_name correct');
if($^O ne 'MSWin32') {
is($info->script_dir(), '/var/www/cgi-bin', 'script_dir correct');
} else {
ok(defined $info->script_dir(), 'script_dir defined on Windows');
}
# Browser classification — Googlebot may be search or robot; both acceptable
my $type = $info->browser_type();
ok($type eq 'search' || $type eq 'robot',
"browser_type is search or robot for Googlebot (got '$type')");
ok(!$info->is_mobile(), 'Googlebot is not mobile');
# No query string
ok(!defined $info->params(), 'empty query string returns undef params');
is($info->status(), 200, 'status 200 for clean bot request');
};
# ============================================================
# 22. Full realistic CGI session: authenticated user submits a form
# ============================================================
subtest 'realistic session: authenticated user form submission' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = 'Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) Chrome/120';
$ENV{REMOTE_ADDR} = '203.0.113.5';
$ENV{HTTP_HOST} = 'www.myapp.example.com';
$ENV{SERVER_PROTOCOL} = 'HTTP/1.1';
$ENV{SCRIPT_FILENAME} = '/var/www/cgi-bin/submit.cgi';
$ENV{SCRIPT_NAME} = '/cgi-bin/submit.cgi';
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'action=save&title=My+Post&category=tech';
$ENV{HTTP_COOKIE} = 'sessionid=s3cr3t; csrf=tok3n';
my $info = CGI::Info->new(allow => {
action => qr/^(save|preview|delete)$/,
title => qr/^[\w\s\+]+$/,
category => qr/^[a-z]+$/,
});
# Browser classification
ok(!$info->is_mobile(), 'desktop Mac not mobile');
ok(!$info->is_robot(), 'Chrome not a robot');
is($info->browser_type(), 'web', 'browser_type is web');
# Site details
is($info->host_name(), 'www.myapp.example.com', 'host correct');
is($info->domain_name(), 'myapp.example.com', 'domain correct');
# Form params
my $p = $info->params();
ok(defined $p, 'params returned');
is($p->{action}, 'save', 'action param correct');
is($p->{category}, 'tech', 'category param correct');
# Individual param access
is($info->param('action'), 'save', 'param(action) correct');
# Cookie access
is($info->cookie('sessionid'), 's3cr3t', 'session cookie read');
is($info->cookie('csrf'), 'tok3n', 'csrf cookie read');
# as_string for cache key
my $key = $info->as_string();
like($key, qr/action=save/, 'as_string usable as cache key');
# Clean status throughout
is($info->status(), 200, 'status 200 for authenticated form submission');
};
# ============================================================
# 23. Stateful: reset() between requests in FCGI-like environment
# ============================================================
subtest 'FCGI-like: reset() between requests prevents state bleed' => sub {
# First request
reset_env();
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'user=alice';
my $p1 = CGI::Info->new()->params();
is($p1->{user}, 'alice', 'first request: user=alice');
# Simulate FCGI reset between requests
CGI::Info->reset();
# Second request with different data
$ENV{QUERY_STRING} = 'user=bob';
my $p2 = CGI::Info->new()->params();
is($p2->{user}, 'bob', 'second request after reset: user=bob');
# No cross-contamination
isnt($p1->{user}, $p2->{user}, 'no state bleed between requests');
};
# ============================================================
# 24. Stateful: messages_as_string joins all messages as semicolons
# ============================================================
subtest 'messages_as_string: multiple messages joined by semicolons' => sub {
reset_env();
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
t/integration.t view on Meta::CPAN
my $info = CGI::Info->new();
ok($info->is_ai(), 'ClaudeBot: is_ai true');
my $params = $info->params();
ok(defined $params, 'params() returns defined value for AI crawler with clean query');
is($params->{page}, '1', 'page param parsed correctly for AI crawler');
is($params->{limit}, '10', 'limit param parsed correctly for AI crawler');
is($info->status(), 200, 'status remains 200 for clean AI request');
};
# Critical WAF invariant: the SQL injection check in is_robot() runs BEFORE
# the is_ai() delegation. An AI crawler embedding a SQL payload in its UA
# must still receive a 403, not bypass the WAF via the AI fast path.
subtest 'is_ai(): WAF fires before AI classification on injected UA' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = $UA_GPTBOT_SQL;
$ENV{REMOTE_ADDR} = $AI_REMOTE;
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'q=test';
my $info = CGI::Info->new();
ok($info->is_robot(), 'SQL payload in GPTBot UA: is_robot true');
is($info->status(), 403,
'SQL payload in GPTBot UA: WAF sets status 403 (not bypassed by AI classification)');
};
# IS_AI=1 env override must propagate so that is_robot() also returns true.
# is_robot() calls is_ai() internally, so the override is observed through
# both methods even if is_ai() has not been called directly.
subtest 'is_ai(): IS_AI=1 override chain propagates to is_robot()' => sub {
reset_env();
local $ENV{IS_AI} = 1;
$ENV{HTTP_USER_AGENT} = $UA_CHROME; # not an AI UA
$ENV{REMOTE_ADDR} = $AI_REMOTE;
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
my $info = CGI::Info->new();
ok($info->is_ai(), 'IS_AI=1: is_ai true for non-AI UA via override');
ok($info->is_robot(), 'IS_AI=1: is_robot also true (invariant via is_robot calling is_ai)');
is($info->browser_type(), 'ai',
'IS_AI=1: browser_type is ai (ai checked before robot in priority order)');
};
# Simulates FCGI-like operation: two sequential requests in the same process.
# reset() must clear the cached is_ai state so the second request is classified
# independently, not inheriting the first request's AI status.
subtest 'is_ai(): reset() clears AI state between requests' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = $UA_CLAUDE_BOT;
$ENV{REMOTE_ADDR} = $AI_REMOTE;
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
my $ai_info = CGI::Info->new();
ok($ai_info->is_ai(), 'first request (ClaudeBot): is_ai true');
ok($ai_info->is_robot(), 'first request (ClaudeBot): is_robot true');
# Simulate end of request; reset class-level stdin cache
CGI::Info->reset();
# Second request arrives with a desktop UA
$ENV{HTTP_USER_AGENT} = $UA_CHROME;
my $plain_info = CGI::Info->new();
ok(!$plain_info->is_ai(), 'second request (Chrome): is_ai false after reset');
ok(!$plain_info->is_robot(), 'second request (Chrome): is_robot false after reset');
};
# browser_type() documents 'mobile' as the highest priority class.
# Even with IS_AI=1 forcing is_ai() true, a mobile UA must still
# return 'mobile', not 'ai', because the mobile check runs first.
subtest 'is_ai(): browser_type() mobile priority beats IS_AI override' => sub {
reset_env();
local $ENV{IS_AI} = 1;
$ENV{HTTP_USER_AGENT} = $UA_IPHONE_AI;
$ENV{REMOTE_ADDR} = $AI_REMOTE;
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
my $info = CGI::Info->new();
ok($info->is_ai(), 'IS_AI=1 + iPhone UA: is_ai true');
ok($info->is_mobile(), 'IS_AI=1 + iPhone UA: is_mobile also true');
is($info->browser_type(), 'mobile',
'IS_AI=1 + iPhone UA: browser_type is mobile (mobile wins over ai)');
};
# A correctly classified AI bot must not generate any log messages.
# Spurious warnings here would pollute monitoring dashboards.
subtest 'is_ai(): clean AI classification produces no messages' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = $UA_CLAUDE_BOT;
$ENV{REMOTE_ADDR} = $AI_REMOTE;
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
my $info = CGI::Info->new();
ok($info->is_ai(), 'ClaudeBot: is_ai true');
my $msgs = $info->messages() // [];
my @warnings = grep { $_->{level} eq 'warn' || $_->{level} eq 'error' } @{$msgs};
is(scalar(@warnings), 0,
'clean AI bot classification produces no warnings or errors in messages()');
};
# AI crawlers must not be mistakenly classified as search engines.
# is_search_engine() and is_ai() represent separate, distinct categories.
subtest 'is_ai(): AI crawlers are not search engines' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = $UA_CLAUDE_BOT;
$ENV{REMOTE_ADDR} = $AI_REMOTE;
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
my $info = CGI::Info->new();
ok($info->is_ai(), 'ClaudeBot: is_ai true');
ok(!$info->is_search_engine(), 'ClaudeBot: is_search_engine false (AI != search engine)');
};
# ChatGPT-User has no "bot" or "spider" token in the UA string, so
# is_robot()'s own regex would not catch it directly. This workflow
# test confirms end-to-end that the invariant path works: is_robot()
# delegates to is_ai() internally, so both return true.
subtest 'is_ai(): ChatGPT-User full workflow -- no bot token in UA' => sub {
reset_env();
$ENV{HTTP_USER_AGENT} = $UA_CHATGPT_USR;
( run in 2.015 seconds using v1.01-cache-2.11-cpan-9789f410c06 )