view release on metacpan or  search on metacpan

lib/Test/CVE.pm  view on Meta::CPAN

 use Test::CVE;

 my $cve = Test::CVE->new (
    verbose  => 0,
    deps     => 1,
    perl     => 1,
    core     => 1,
    minimum  => 0,
    cpansa   => "https://cpan-security.github.io/cpansa-feed/cpansa.json",
    cpanfile => "cpanfile",
    meta_jsn => "META.json",
    meta_yml => "META.yml",     # NYI
    make_pl  => "Makefile.PL",
    build_pl => "Build.PL",     # NYI
    want     => [],
    );

 $cve->want ("Foo::Bar", "4.321");
 $cve->want ("ExtUtils-MakeMaker");

 $cve->test;
 print $cve->report (width => $ENV{COLUMNS} || 80);
 my $csv = $cve->csv;

=cut

use 5.014000;
use warnings;

our $VERSION = "0.07";

use version;
use Carp;
use HTTP::Tiny;
use Text::Wrap;
use JSON::MaybeXS;
use List::Util qw( first );

# TODO:
# NEW! https://fastapi.metacpan.org/cve/CPANSA-YAML-LibYAML-2012-1152
#      https://fastapi.metacpan.org/cve/release/YAML-1.20_001

sub new {
    my $class = shift;
    @_ % 2 and croak "Uneven number of arguments";
    my %self  = @_;
    $self{cpansa}   ||= "https://perl-toolchain-gang.github.io/cpansa-feed/cpansa.json";
    $self{deps}     //= 1;
    $self{perl}     //= 1;
    $self{core}     //= 1;
    $self{minimum}  //= 0;
    $self{verbose}  //= 0;
    $self{width}    //= $ENV{COLUMNS} // 80;
    $self{want}     //= [];
    $self{cpanfile} ||= "cpanfile";
    $self{meta_jsn} ||= "META.json";
    $self{meta_yml} ||= "META.yml";
    $self{make_pl}  ||= "Makefile.PL";
    $self{build_pl} ||= "Build.PL";
    $self{CVE}        = {};
    bless \%self => $class;
    } # new

sub _read_cpansa {
    my $self = shift;
    my $src  = $self->{cpansa} or croak "No source for CVE database";
    $self->{verbose} and warn "Reading $src ...\n";

    # 'Compress-LZ4'   => [
    #   { affected_versions => [
    #       '<0.20'
    #       ],
    #     cpansa_id         => 'CPANSA-Compress-LZ4-2014-01',
    #     cves              => [],
    #     description       => 'Outdated LZ4 source code with security issue on 32bit systems.
    #
    #     references        => [
    #       'https://metacpan.org/changes/distribution/Compress-LZ4',
    #       'https://github.com/gray/compress-lz4/commit/fc503812b4cbba16429658e1dfe20ad8bbfd77a0'
    #       ],
    #     reported          => '2014-07-07',
    #     severity          => undef
    #     }
    #   ],

    if (-s $src) {
	open my $fh, "<", $src or croak "$src: $!\n";
	local $/;
	$self->{j}{db} = decode_json (<$fh>);
	close $fh;
	}
    else {
	my $r = HTTP::Tiny->new (verify_SSL => 1)->get ($src);
	$r->{success} or die "$src: $@\n";

	$self->{verbose} > 1 and warn "Got it. Decoding\n";
	if (my $c = $r->{content}) {
	    # Skip warning part
	    # CPANSA-perl-2023-47038 has more than 1 range bundled together in '>=5.30.0,<5.34.3,>=5.36.0,<5.36.3,>=5.38.0,<5.38.2'
	    # {"Alien-PCRE2":[{"affected_versions":["<0.016000"],"cpansa_id":"CPANSA-Alien-PCRE2-2019-20454","cves":["CVE-2019-20454"],"description":"An out-
	    $c =~ s/^\s*([^{]+?)[\s\r\n]*\{/{/s and warn "$1\n";
	    $self->{j}{db} = decode_json ($c);
	    }
	else {
	    $self->{j}{db} = undef;
	    }
	}
    $self->{j}{mod} = [ sort keys %{$self->{j}{db} // {}} ];
    $self;
    } # _read_cpansa

sub _read_MakefilePL {
    my ($self, $mf) = @_;
    $mf ||= $self->{make_pl};

    $self->{verbose} and warn "Reading $mf ...\n";
    open my $fh, "<", $mf or return $self;
    my $mfc = do { local $/; <$fh> };
    close $fh;

    $mfc or return $self;