Affix

 view release on metacpan or  search on metacpan

lib/Affix/Wrap.pm  view on Meta::CPAN

            # Atomic Engine Batch
            my @fwd = sort keys %{ { map { $_ => 1 } ( keys %unique_types, keys %referenced_names ) } };
            my @batch_lines;
            for my $name ( sort keys %unique_types ) {
                my $sig = $unique_types{$name}->affix_type;
                push @batch_lines, "    typedef $name => $sig;" if $sig && $sig ne "$name()";
            }
            my $batch_str = @batch_lines ? join( "\n", @batch_lines ) . "\n" : "";

            # Perl Module Construction
            # Safely quote $lib: escape \ and ] within q[...] delimiters
            my $_lib = '';
            if ( defined $lib ) {
                my $safe_lib = $lib;
                $safe_lib =~ s/\\/\\\\/g;
                $safe_lib =~ s/\]/\\]/g;
                $_lib = "my \$lib = q[$safe_lib];";
            }
            my $out = <<~"PERL";
            package $pkg {
                use v5.40;

t/025_affix_wrap.t  view on Meta::CPAN

                my $evil_lib = 'lib]; system("echo PWNED"); #';
                my $pm_file  = $dir->child('evil_lib.pm');
                lives { $binder->generate( $evil_lib, 'Safe::Lib', $pm_file->stringify ) }
                    or bail_out 'generate() died on malicious lib';
                ok -e $pm_file, 'Generated .pm file despite malicious lib';
                my $content = $pm_file->slurp_utf8;

                # Package declaration must be clean
                like $content, qr/package\s+Safe::Lib\s*\{/, 'Package declaration is safe';

                # The ] in the payload must be escaped inside q[...] so it doesn't break out
                like $content, qr/q\[.*\\\].*\]/, 'Closing bracket escaped inside q[...]';

                # The entire file must compile — proves the payload is inert
                my ( undef, undef, $exit ) = capture { system $^X, '-Ilib', '-c', $pm_file->stringify };
                is $exit >> 8, 0, 'Generated code compiles despite malicious lib';
            };

            # Malicious $pkg names must be rejected with a croak
            subtest 'Malicious pkg names rejected' => sub {
                my @bad_pkgs = (
                    [ 'Evil::pkg; system("echo PWNED")',    'semicolon injection' ],

t/025_affix_wrap.t  view on Meta::CPAN

            };

            # $lib with backslashes (Windows paths) must be handled
            subtest 'Windows-style lib paths' => sub {
                my $win_lib = 'C:\Users\Test\lib.dll';
                my $pm_file = $dir->child('winpath.pm');
                lives { $binder->generate( $win_lib, 'WinPathTest', $pm_file->stringify ) }
                    or bail_out 'generate() died on Windows path';
                my $content = $pm_file->slurp_utf8;

                # Backslashes are doubled when escaped for q[...] (\\ -> \\\\)
                like $content, qr/q\[.*C:\\\\Users\\\\Test\\\\lib\.dll\]/, 'Windows path safely quoted';
                my ( undef, undef, $exit ) = capture { system $^X, '-Ilib', '-c', $pm_file->stringify };
                is $exit >> 8, 0, 'Generated code compiles with Windows path';
            };

            # wrap() must also reject bad $pkg
            subtest 'wrap() rejects malicious pkg' => sub {
                ok dies { $binder->wrap( 'good_lib', 'Evil; system("echo PWNED")' ) }, 'wrap() rejects malicious pkg name';
            };
        };

t/070_security_fixes.t  view on Meta::CPAN

#
subtest 'H6: BSD find_library regex uses \Q quoting' => sub {
    use Affix::Platform::BSD;

    # We can't easily test the regex directly since \Q is consumed by qr//,
    # but we CAN test that malicious library names don't produce false matches.
    # Verify the regex is compiled (won't die when constructed with evil name)
    my $evil_name = q[m; rm -rf /];
    my $regex     = qr[-l\Q$evil_name\E\.[^\s]+.+\s*=>\s*(.+)$];

    # The escaped name should NOT match a legitimate ldconfig output line
    unlike '-lm.1 => /lib/libm.so.1', $regex, 'Evil name does not match legitimate ldconfig line';

    # A safe name should match ldconfig-style output
    my $safe_name  = 'm';
    my $safe_regex = qr[-l\Q$safe_name\E\.[^\s]+.+\s*=>\s*(.+)$];
    like '-lm.1 => /lib/libm.so.1', $safe_regex, 'Safe name matches ldconfig output format';
};
#
subtest 'H7/H8: Macro name validation prevents symbol table injection' => sub {
    use Affix::Wrap;