CGI-Info

 view release on metacpan or  search on metacpan

bin/testjson.pl  view on Meta::CPAN

use LWP::UserAgent;

my $ua = LWP::UserAgent->new();

my $req = HTTP::Request->new(POST => 'https://localhost/cgi-bin/info.pl');
$req->header('content-type' => 'application/json');
$req->content('{ "first": "Nigel", "last": "Horne" }');

my $resp = $ua->request($req);
if($resp->is_success()) {
	print "Reply:\n\t", $resp->decoded_content, "\n";
} else {
	print STDERR $resp->code(), "\n", $resp->message(), "\n";
}

scripts/generate_index.pl  view on Meta::CPAN

# belongs to the project under test, not to
# App::Test::Generator itself.
#
# High/Medium difficulty survivors get TODO stubs.
# Low difficulty survivors get comment-only hints.
# Mutants on the same line are deduplicated into one
# stub listing all variants — one test kills them all.
# File is skipped entirely if nothing to report.
#
# Arguments:
#   $mutation_db  - decoded mutation JSON hashref
#   $cover_db     - decoded Devel::Cover JSON hashref
#   $test_dir     - directory to write the .t file (default: 't')
#
# Returns:
#   The filename written, or undef if nothing written
# --------------------------------------------------
sub _generate_mutant_tests {
	my ($mutation_db, $cover_db, $test_dir, $generate_test) = @_;

	# Default output directory is the project's t/ directory
	$test_dir //= 't';

scripts/generate_index.pl  view on Meta::CPAN

# Purpose:    Scan t/conf/ for existing YAML schema
#             files and augment copies of them with
#             boundary values extracted from surviving
#             NUM_BOUNDARY mutants whose enclosing sub
#             matches the schema's function field.
#             The original schema is never modified.
#             Augmented copies are written with a
#             timestamped mutant_fuzz_ prefix so they
#             are picked up by t/fuzz.t automatically.
#
# Entry:      $mutation_db - decoded mutation JSON
#                            hashref
#             $test_dir    - base test directory
#                            (default: 't')
#
# Exit:       Returns the number of augmented schema
#             files written. Returns 0 if no matching
#             survivors were found.
#
# Side effects: Writes .yml files to $test_dir/conf/.
#               Prints progress if $config{verbose}.

scripts/generate_index.pl  view on Meta::CPAN

# _mutation_index
#
# Purpose:    Build the HTML mutation report section
#             for the main dashboard page. Produces
#             the mutation summary (score, totals),
#             the per-file mutation files table with
#             TER1/TER2/TER3 badges, and the
#             structural coverage and executive
#             summary blocks.
#
# Entry:      $data          - decoded mutation JSON
#                              hashref (score, total,
#                              killed, survived)
#             $files         - hashref of file =>
#                              { killed => [], survived => [] }
#                              as produced by _group_by_file
#             $coverage_data - decoded Devel::Cover JSON
#                              hashref, or undef
#             $lcsaj_dir     - root directory for LCSAJ
#                              .json files, or undef
#             $lcsaj_hits    - hashref of LCSAJ hit data
#                              as produced by the runtime
#                              debugger, or undef
#
# Exit:       Returns an arrayref of HTML strings
#             ready to be pushed onto @html.
#             Never returns undef.

t/edge_cases.t  view on Meta::CPAN

subtest 'URL encoding: plus signs as spaces' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'msg=hello+world&empty=+';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on plus-encoded spaces');
    if(defined $p && defined $p->{msg}) {
        is($p->{msg}, 'hello world', 'plus decoded to space');
    }
};

# ============================================================
# 3. WAF: boundary and near-miss attack patterns
# ============================================================

subtest 'WAF: SQL keyword in value without injection pattern (should pass)' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';

t/extended_tests.t  view on Meta::CPAN

    ok(defined $p,        'HEAD request returns params');
    is($p->{x}, '1',     'x=1 parsed from HEAD');
    is($p->{y}, '2',     'y=2 parsed from HEAD');
};

# ============================================================
# 10. params() — \\u0026 Unicode ampersand escape in QUERY_STRING
#     Branch: $query =~ s/\\u0026/\&/g
# ============================================================

subtest 'params: \\u0026 unicode ampersand escape decoded' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'a=1\\u0026b=2';

    my $info = CGI::Info->new();
    my $p    = $info->params();
    ok(defined $p, 'params returned with \\u0026 encoded ampersand');
    is($p->{a}, '1', 'a=1 parsed after \\u0026 decoded');
    is($p->{b}, '2', 'b=2 parsed after \\u0026 decoded');
};

# ============================================================
# 11. params() — upload_dir not absolute => 500
#     Branch: !File::Spec->file_name_is_absolute($self->{upload_dir})
# ============================================================

subtest 'params: multipart with relative upload_dir => 500' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';

t/waf.t  view on Meta::CPAN

subtest 'Parameter Sanitization' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'GET',
		QUERY_STRING => 'key%00=evil%00data&value=valid+data',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	is($params->{key}, 'evildata', 'NUL bytes in key removed');
	is($params->{value}, 'valid data', 'Spaces correctly decoded');
};

subtest 'Max Upload Size Enforcement' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'POST',
		CONTENT_TYPE => 'application/x-www-form-urlencoded',
		CONTENT_LENGTH => 1024 * 1024 * 600,	# 600MB
	);
	$info = CGI::Info->new(max_upload => 500 * 1024);	# 500KB