view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

    $ENV{HTTP_HOST}  = 'secure.example.org';

    my $info = CGI::Info->new();

    is($info->protocol(),    'https',              'protocol is https');
    is($info->host_name(),   'secure.example.org', 'host_name correct');
    is($info->domain_name(), 'secure.example.org', 'domain_name (no www to strip)');
    like($info->cgi_host_url(), qr{^https?://},    'cgi_host_url has protocol');
};

# ============================================================
# 12. script_name, script_path, script_dir all consistent
# ============================================================

subtest 'script methods: name, path, dir all consistent' => sub {
    reset_env();
    if($^O eq 'MSWin32') {
        pass('script methods Unix-path test skipped on Windows');
        return;
    }
    $ENV{SCRIPT_FILENAME} = '/var/www/cgi-bin/myapp.cgi';
    $ENV{SCRIPT_NAME}     = '/cgi-bin/myapp.cgi';

    my $info = CGI::Info->new();

    my $name = $info->script_name();
    my $path = $info->script_path();
    my $dir  = $info->script_dir();

    is($name, 'myapp.cgi',                  'script_name is basename');
    is($path, '/var/www/cgi-bin/myapp.cgi', 'script_path is full path from SCRIPT_FILENAME');
    is($dir,  '/var/www/cgi-bin',           'script_dir is containing dir of script_path');

    # script_name is the basename of script_path
    like($path, qr/\Q$name\E$/, 'script_path ends with script_name');

    # script_dir is the directory portion of script_path
    like($path, qr/^\Q$dir\E/, 'script_path begins with script_dir');
};

# ============================================================
# 13. cookie() works alongside params() in the same session
# ============================================================

subtest 'cookies and params coexist in same request' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'page=2&sort=date';
    $ENV{HTTP_COOKIE}       = 'session=abc123; theme=dark';

    my $info = CGI::Info->new();

    my $params = $info->params();
    is($params->{page}, '2',    'page param parsed');
    is($params->{sort}, 'date', 'sort param parsed');

    is($info->cookie('session'), 'abc123', 'session cookie read');
    is($info->cookie('theme'),   'dark',   'theme cookie read');

    # Cookie lookup doesn't disturb params
    is($info->param('page'), '2',    'param still intact after cookie lookup');
    is($info->param('sort'), 'date', 'sort param still intact');
};

subtest 'cookie: repeated lookups return same value (stateful jar)' => sub {
    reset_env();
    $ENV{HTTP_COOKIE} = 'user=nigel; prefs=verbose';

    my $info = CGI::Info->new();
    my $first  = $info->cookie('user');
    my $second = $info->cookie('user');
    is($first, $second, 'repeated cookie() calls return same value');
    is($first, 'nigel', 'cookie value is correct');
};

# ============================================================
# 14. tmpdir, logdir, rootdir: directory methods cross-check
# ============================================================

subtest 'directory methods: all return valid directories' => sub {
    reset_env();
    my $tmp = tempdir(CLEANUP => 1);
    $ENV{C_DOCUMENT_ROOT} = $tmp;

    my $info = CGI::Info->new();

    my $tmpdir  = $info->tmpdir();
    my $rootdir = $info->rootdir();
    my $logdir  = $info->logdir();

    ok(-d $tmpdir,  'tmpdir() is a directory');
    ok(-d $rootdir, 'rootdir() is a directory');
    ok(-d $logdir,  'logdir() is a directory');

    ok(-w $tmpdir, 'tmpdir() is writable');
    ok(-w $logdir, 'logdir() is writable');

    is($rootdir, $tmp, 'rootdir() returns C_DOCUMENT_ROOT');
};

subtest 'logdir: set then get returns same value' => sub {
    reset_env();
    my $tmp  = tempdir(CLEANUP => 1);
    my $info = CGI::Info->new();

    $info->logdir($tmp);
    is($info->logdir(), $tmp, 'logdir() returns previously set directory');
};

# ============================================================
# 15. WAF: multiple attack types in sequence, each gets correct status
# ============================================================

subtest 'WAF: SQL injection blocked with 403' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = "id=1'%20OR%201=1";

    my $info = CGI::Info->new();

t/integration.t  view on Meta::CPAN

    # 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';
    $ENV{REQUEST_METHOD}    = 'GET';
    # Two params that will both fail validation
    $ENV{QUERY_STRING}      = 'foo=bad&bar=alsoBad';

    my $info = CGI::Info->new();
    $info->params(allow => {
        foo => qr/^\d+$/,
        bar => qr/^\d+$/,
    });

    my $msgs = $info->messages();
    if($msgs && scalar @{$msgs} > 1) {
        my $str = $info->messages_as_string();
        like($str, qr/;/, 'multiple messages joined by semicolons');
    } else {
        pass('fewer than 2 messages logged (acceptable)');
    }