view release on metacpan or  search on metacpan

lib/App/Project/Doctor/Check/Security.pm  view on Meta::CPAN

package App::Project::Doctor::Check::Security;

use strict;
use warnings;
use autodie qw(:all);

use parent -norequire, 'App::Project::Doctor::Check::Base';

use Carp qw(croak carp);
use Readonly;

our $VERSION = '0.02';

Readonly::Array my @SECRET_PATTERNS => (
	qr/(?:password|passwd|secret|api_?key|token)\s*=\s*['"][^'"]{4,}['"]/i,
	qr/-----BEGIN (?:RSA |EC )?PRIVATE KEY-----/,
	qr/(?:AKIA|ASIA)[A-Z0-9]{16}/,
);

sub name        { 'Security' }
sub description { 'All modules declare strict/warnings; no hardcoded credentials.' }
sub can_fix     { 1 }
sub order       { 60 }

sub check {
	my ($self, $ctx) = @_;
	croak 'check requires an App::Project::Doctor::Context' unless ref $ctx;

	my @findings;
	my $files = $ctx->perl_files('lib', 'script', 'bin');

	for my $rel (@{$files}) {
		my $content = eval { $ctx->slurp($rel) } // do { carp "Cannot slurp $rel"; next };

		# strict / warnings -- skip .t files (they inherit from test harness).
		unless ($rel =~ /\.t$/) {
			unless ($content =~ /^\s*use\s+strict\b/m) {
				push @findings, _f(
					severity => 'error',
					message  => "Missing 'use strict' in $rel.",
					file     => $rel,
					fix      => _fix_pragma($ctx, $rel, 'strict'),
				);
			}
			unless ($content =~ /^\s*use\s+warnings\b/m) {
				push @findings, _f(
					severity => 'error',
					message  => "Missing 'use warnings' in $rel.",
					file     => $rel,
					fix      => _fix_pragma($ctx, $rel, 'warnings'),
				);
			}
		}

		# Credential scan.
		my @lines = split /\n/, $content;
		for my $i (0 .. $#lines) {
			for my $pat (@SECRET_PATTERNS) {
				if ($lines[$i] =~ $pat) {
					push @findings, _f(
						severity => 'error',
						message  => "Possible hardcoded credential in $rel at line " . ($i + 1) . '.',
						file     => $rel,
						line     => $i + 1,
						detail   => 'Move secrets to environment variables or a config file.',
					);
					last;
				}
			}
		}
	}

	unless (@findings) {
		push @findings, _f(
			severity => 'pass',
			message  => 'All checked files use strict/warnings; no credential patterns found.',
		);
	}

	return @findings;
}