File Coverage

blib/lib/Test/CVE.pm
Criterion Covered Total %
statement 151 336 44.9
branch 56 196 28.5
condition 41 155 26.4
subroutine 19 26 73.0
pod 8 8 100.0
total 275 721 38.1


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Test::CVE;
4              
5             =head1 NAME
6              
7             Test::CVE - Test against known CVE's
8              
9             =head1 SYNOPSIS
10              
11             use Test::CVE;
12              
13             my $cve = Test::CVE->new (
14             verbose => 0,
15             deps => 1,
16             perl => 1,
17             core => 1,
18             minimum => 0,
19             cpansa => "https://cpan-security.github.io/cpansa-feed/cpansa.json",
20             cpanfile => "cpanfile",
21             meta_jsn => "META.json",
22             meta_yml => "META.yml", # NYI
23             make_pl => "Makefile.PL",
24             build_pl => "Build.PL", # NYI
25             want => [],
26             skip => "CVE.SKIP",
27             );
28              
29             $cve->skip ("CVE.SKIP");
30             $cve->skip ([qw( CVE-2011-0123 CVE-2020-1234 )]);
31              
32             $cve->want ("Foo::Bar", "4.321");
33             $cve->want ("ExtUtils-MakeMaker");
34              
35             $cve->test;
36             print $cve->report (width => $ENV{COLUMNS} || 80);
37             my $csv = $cve->csv;
38              
39             has_no_cves (....);
40              
41             =cut
42              
43 4     4   789507 use 5.014000;
  4         19  
44 4     4   26 use warnings;
  4         10  
  4         477  
45              
46             our $VERSION = "0.13";
47              
48 4     4   924 use version;
  4         4078  
  4         27  
49 4     4   449 use Carp;
  4         13  
  4         426  
50 4     4   3859 use HTTP::Tiny;
  4         283542  
  4         288  
51 4     4   2449 use Text::Wrap;
  4         14856  
  4         317  
52 4     4   2306 use JSON::MaybeXS;
  4         48518  
  4         379  
53 4     4   18464 use Module::CoreList;
  4         973181  
  4         55  
54 4     4   11172 use YAML::PP ();
  4         330499  
  4         135  
55 4     4   35 use List::Util qw( first uniq );
  4         7  
  4         328  
56 4     4   24 use base qw( Test::Builder::Module );
  4         8  
  4         425  
57              
58 4     4   849 use parent "Exporter";
  4         668  
  4         49  
59             our @EXPORT = qw( has_no_cves );
60              
61             # TODO:
62             # * NEW! https://fastapi.metacpan.org/cve/CPANSA-YAML-LibYAML-2012-1152
63             # https://fastapi.metacpan.org/cve/release/YAML-1.20_001
64             # * Module::Install Makefile.PL's
65             # use inc::Module::Install;
66             # name 'Algorithm-Diff-XS';
67             # license 'perl';
68             # all_from 'lib/Algorithm/Diff/XS.pm';
69             # * Module::Build
70              
71             sub new {
72 4     4 1 427368 my $class = shift;
73 4 50       26 @_ % 2 and croak "Uneven number of arguments";
74 4         20 my %self = @_;
75 4   50     51 $self{cpansa} ||= "https://cpan-security.github.io/cpansa-feed/cpansa.json";
76 4   100     29 $self{deps} //= 1;
77 4   50     27 $self{perl} //= 1;
78 4   50     53 $self{core} //= 1;
79 4   100     23 $self{minimum} //= 0;
80 4   100     50 $self{verbose} //= 0;
81 4   50     60 $self{width} //= $ENV{COLUMNS} // 80;
      33        
82 4   100     28 $self{want} //= [];
83 4   100     40 $self{cpanfile} ||= "cpanfile";
84 4   50     29 $self{meta_jsn} ||= "META.json";
85 4   50     24 $self{meta_yml} ||= "META.yml";
86 4   50     26 $self{make_pl} ||= "Makefile.PL";
87 4   50     26 $self{build_pl} ||= "Build.PL";
88 4         8 $self{CVE} = {};
89 4 100       20 ref $self{want} or $self{want} = [ $self{want} ]; # new->(want => "Foo")
90 4         15 my $obj = bless \%self => $class;
91 4   50     34 $obj->skip ($self{skip} // "CVE.SKIP");
92 4         27 return $obj;
93             } # new
94              
95             sub skip {
96 4     4 1 8 my $self = shift;
97 4 50       15 if (@_) {
98 4 50       18 if (my $skip = shift) {
99 4 50 33     38 if (ref $skip eq "HASH") {
    50          
    50          
100 0         0 $self->{skip} = $skip;
101             }
102             elsif (ref $skip eq "ARRAY") {
103 0         0 $self->{skip} = { map { $_ => 1 } @$skip };
  0         0  
104             }
105             elsif ($skip =~ m/^\x20-\xff]+$/ and open my $fh, "<", $skip) {
106 0         0 my %s;
107 0         0 while (<$fh>) {
108 0         0 s/[\s\r\n]+\z//;
109 0 0       0 m/^\s*(\w[-\w]+)(?:\s+(.*))?$/ or next;
110 0   0     0 $s{$1} = $2 // "";
111             }
112 0         0 close $fh;
113 0         0 $self->{skip} = { %s };
114             }
115             else {
116             $self->{skip} = {
117 0         0 map { $_ => 1 }
118 4         12 grep { m/^\w[-\w]+$/ }
  4         65  
119             $skip, @_
120             };
121             }
122             }
123             else {
124 0         0 $self->{skip} = undef;
125             }
126             }
127 4   50     18 $self->{skip} ||= {};
128 4         10 return [ sort keys %{$self->{skip}} ];
  4         19  
129             } # skip
130              
131             sub _read_cpansa {
132 1     1   3 my $self = shift;
133 1 50       5 my $src = $self->{cpansa} or croak "No source for CVE database";
134 1 50       5 $self->{verbose} and warn "Reading $src ...\n";
135              
136             # Old format
137             # 'Compress-LZ4' => [
138             # { affected_versions => [
139             # '<0.20'
140             # ],
141             # cpansa_id => 'CPANSA-Compress-LZ4-2014-01',
142             # cves => [],
143             # description => 'Outdated LZ4 source code with security issue on 32bit systems.
144             #
145             # references => [
146             # 'https://metacpan.org/changes/distribution/Compress-LZ4',
147             # 'https://github.com/gray/compress-lz4/commit/fc503812b4cbba16429658e1dfe20ad8bbfd77a0'
148             # ],
149             # reported => '2014-07-07',
150             # severity => undef
151             # }
152             # ],
153              
154             # New format
155             # "Compress-Raw-Bzip2" : [
156             # { "affected_releases" : [ ],
157             # "cpansec_index" : "abc76ca939abad86a25c686b4d73fbecb8332f21",
158             # "cve" : "{\"dataType\":\"CVE_RECORD\",\"dataVersion\":\"5.1\",\"containers\":{\"adp\":[{\"providerMetadata\":{\"orgId\":\"af854a3a-2127-422b-91ae-364da2661108\",\"shortName\":\"CVE\",\"dateUpdated\":\"2024-08-07T00:45:12.275Z\"},\"title\":\"CVE Program Container\",\"references\":[{\"tags\":[\"vendor-advisory\",\"x_refsource_UBUNTU\",\"x_transferred\"],\"name\":\"USN-986-3\",\"url\":\"http://www.ubuntu.com/usn/USN-986-3\"},{\"url\":\"http://git.clamav.net/gitweb?p=clamav-devel.git%3Ba=blob_plain%3Bf=ChangeLog%3Bhb=clamav-0.96.3\",\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"]},{\"url\":\"http://lists.fedoraproject.org/pipermail/package-announce/2010-November/051278.html\",\"name\":\"FEDORA-2010-17439\",\"tags\":[\"vendor-advisory\",\"x_refsource_FEDORA\",\"x_transferred\"]},{\"url\":\"http://www.ubuntu.com/usn/usn-986-1\",\"name\":\"USN-986-1\",\"tags\":[\"vendor-advisory\",\"x_refsource_UBUNTU\",\"x_transferred\"]},{\"name\":\"USN-986-2\",\"tags\":[\"vendor-advisory\",\"x_refsource_UBUNTU\",\"x_transferred\"],\"url\":\"http://www.ubuntu.com/usn/USN-986-2\"},{\"url\":\"http://secunia.com/advisories/41452\",\"name\":\"41452\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"]},{\"url\":\"http://secunia.com/advisories/42404\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"],\"name\":\"42404\"},{\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"],\"name\":\"48378\",\"url\":\"http://secunia.com/advisories/48378\"},{\"url\":\"https://wwws.clamav.net/bugzilla/show_bug.cgi?id=2230\",\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"]},{\"name\":\"ADV-2010-3073\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\",\"x_transferred\"],\"url\":\"http://www.vupen.com/english/advisories/2010/3073\"},{\"url\":\"http://www.vupen.com/english/advisories/2010/2455\",\"name\":\"ADV-2010-2455\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\",\"x_transferred\"]},{\"tags\":[\"vendor-advisory\",\"x_refsource_APPLE\",\"x_transferred\"],\"name\":\"APPLE-SA-2011-03-21-1\",\"url\":\"http://lists.apple.com/archives/security-announce/2011/Mar/msg00006.html\"},{\"url\":\"http://secunia.com/advisories/42530\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"],\"name\":\"42530\"},{\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"],\"url\":\"https://wwws.clamav.net/bugzilla/show_bug.cgi?id=2231\"},{\"url\":\"http://marc.info/?l=oss-security&m=128506868510655&w=2\",\"name\":\"[oss-security] 20100921 bzip2 CVE-2010-0405 integer overflow\",\"tags\":[\"mailing-list\",\"x_refsource_MLIST\",\"x_transferred\"]},{\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"],\"name\":\"42529\",\"url\":\"http://secunia.com/advisories/42529\"},{\"url\":\"http://www.securityfocus.com/archive/1/515055/100/0/threaded\",\"name\":\"20101207 VMSA-2010-0019 VMware ESX third party updates for Service Console\",\"tags\":[\"mailing-list\",\"x_refsource_BUGTRAQ\",\"x_transferred\"]},{\"url\":\"http://secunia.com/advisories/41505\",\"name\":\"41505\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"]},{\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\",\"x_transferred\"],\"name\":\"ADV-2010-3052\",\"url\":\"http://www.vupen.com/english/advisories/2010/3052\"},{\"tags\":[\"vendor-advisory\",\"x_refsource_REDHAT\",\"x_transferred\"],\"name\":\"RHSA-2010:0703\",\"url\":\"http://www.redhat.com/support/errata/RHSA-2010-0703.html\"},{\"name\":\"RHSA-2010:0858\",\"tags\":[\"vendor-advisory\",\"x_refsource_REDHAT\",\"x_transferred\"],\"url\":\"http://www.redhat.com/support/errata/RHSA-2010-0858.html\"},{\"name\":\"FEDORA-2010-1512\",\"tags\":[\"vendor-advisory\",\"x_refsource_FEDORA\",\"x_transferred\"],\"url\":\"http://lists.fedoraproject.org/pipermail/package-announce/2010-November/051366.html\"},{\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"],\"url\":\"http://blogs.sun.com/security/entry/cve_2010_0405_integer_overflow\"},{\"name\":\"42405\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"],\"url\":\"http://secunia.com/advisories/42405\"},{\"url\":\"http://xorl.wordpress.com/2010/09/21/cve-2010-0405-bzip2-integer-overflow/\",\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"]},{\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"],\"url\":\"https://bugzilla.redhat.com/show_bug.cgi?id=627882\"},{\"name\":\"ADV-2010-3126\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\",\"x_transferred\"],\"url\":\"http://www.vupen.com/english/advisories/2010/3126\"},{\"name\":\"GLSA-201301-05\",\"tags\":[\"vendor-advisory\",\"x_refsource_GENTOO\",\"x_transferred\"],\"url\":\"http://security.gentoo.org/glsa/glsa-201301-05.xml\"},{\"url\":\"http://www.vmware.com/security/advisories/VMSA-2010-0019.html\",\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"]},{\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"],\"url\":\"http://www.bzip.org/\"},{\"url\":\"http://www.vupen.com/english/advisories/2010/3127\",\"name\":\"ADV-2010-3127\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\",\"x_transferred\"]},{\"name\":\"ADV-2010-3043\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\",\"x_transferred\"],\"url\":\"http://www.vupen.com/english/advisories/2010/3043\"},{\"name\":\"SUSE-SR:2010:018\",\"tags\":[\"vendor-advisory\",\"x_refsource_SUSE\",\"x_transferred\"],\"url\":\"http://lists.opensuse.org/opensuse-security-announce/2010-10/msg00000.html\"},{\"url\":\"http://secunia.com/advisories/42350\",\"name\":\"42350\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"]},{\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"],\"url\":\"http://support.apple.com/kb/HT4581\"}]}],\"cna\":{\"descriptions\":[{\"value\":\"Integer overflow in the BZ2_decompress function in decompress.c in bzip2 and libbzip2 before 1.0.6 allows context-dependent attackers to cause a denial of service (application crash) or possibly execute arbitrary code via a crafted compressed file.\",\"lang\":\"en\"}],\"datePublic\":\"2010-09-21T00:00:00\",\"affected\":[{\"vendor\":\"n/a\",\"product\":\"n/a\",\"versions\":[{\"version\":\"n/a\",\"status\":\"affected\"}]}],\"references\":[{\"tags\":[\"vendor-advisory\",\"x_refsource_UBUNTU\"],\"name\":\"USN-986-3\",\"url\":\"http://www.ubuntu.com/usn/USN-986-3\"},{\"url\":\"http://git.clamav.net/gitweb?p=clamav-devel.git%3Ba=blob_plain%3Bf=ChangeLog%3Bhb=clamav-0.96.3\",\"tags\":[\"x_refsource_CONFIRM\"]},{\"url\":\"http://lists.fedoraproject.org/pipermail/package-announce/2010-November/051278.html\",\"name\":\"FEDORA-2010-17439\",\"tags\":[\"vendor-advisory\",\"x_refsource_FEDORA\"]},{\"url\":\"http://www.ubuntu.com/usn/usn-986-1\",\"tags\":[\"vendor-advisory\",\"x_refsource_UBUNTU\"],\"name\":\"USN-986-1\"},{\"name\":\"USN-986-2\",\"tags\":[\"vendor-advisory\",\"x_refsource_UBUNTU\"],\"url\":\"http://www.ubuntu.com/usn/USN-986-2\"},{\"url\":\"http://secunia.com/advisories/41452\",\"name\":\"41452\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"]},{\"url\":\"http://secunia.com/advisories/42404\",\"name\":\"42404\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"]},{\"url\":\"http://secunia.com/advisories/48378\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"],\"name\":\"48378\"},{\"url\":\"https://wwws.clamav.net/bugzilla/show_bug.cgi?id=2230\",\"tags\":[\"x_refsource_CONFIRM\"]},{\"url\":\"http://www.vupen.com/english/advisories/2010/3073\",\"name\":\"ADV-2010-3073\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\"]},{\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\"],\"name\":\"ADV-2010-2455\",\"url\":\"http://www.vupen.com/english/advisories/2010/2455\"},{\"url\":\"http://lists.apple.com/archives/security-announce/2011/Mar/msg00006.html\",\"name\":\"APPLE-SA-2011-03-21-1\",\"tags\":[\"vendor-advisory\",\"x_refsource_APPLE\"]},{\"url\":\"http://secunia.com/advisories/42530\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"],\"name\":\"42530\"},{\"url\":\"https://wwws.clamav.net/bugzilla/show_bug.cgi?id=2231\",\"tags\":[\"x_refsource_CONFIRM\"]},{\"name\":\"[oss-security] 20100921 bzip2 CVE-2010-0405 integer overflow\",\"tags\":[\"mailing-list\",\"x_refsource_MLIST\"],\"url\":\"http://marc.info/?l=oss-security&m=128506868510655&w=2\"},{\"url\":\"http://secunia.com/advisories/42529\",\"name\":\"42529\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"]},{\"url\":\"http://www.securityfocus.com/archive/1/515055/100/0/threaded\",\"tags\":[\"mailing-list\",\"x_refsource_BUGTRAQ\"],\"name\":\"20101207 VMSA-2010-0019 VMware ESX third party updates for Service Console\"},{\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"],\"name\":\"41505\",\"url\":\"http://secunia.com/advisories/41505\"},{\"name\":\"ADV-2010-3052\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\"],\"url\":\"http://www.vupen.com/english/advisories/2010/3052\"},{\"url\":\"http://www.redhat.com/support/errata/RHSA-2010-0703.html\",\"tags\":[\"vendor-advisory\",\"x_refsource_REDHAT\"],\"name\":\"RHSA-2010:0703\"},{\"tags\":[\"vendor-advisory\",\"x_refsource_REDHAT\"],\"name\":\"RHSA-2010:0858\",\"url\":\"http://www.redhat.com/support/errata/RHSA-2010-0858.html\"},{\"tags\":[\"vendor-advisory\",\"x_refsource_FEDORA\"],\"name\":\"FEDORA-2010-1512\",\"url\":\"http://lists.fedoraproject.org/pipermail/package-announce/2010-November/051366.html\"},{\"url\":\"http://blogs.sun.com/security/entry/cve_2010_0405_integer_overflow\",\"tags\":[\"x_refsource_CONFIRM\"]},{\"url\":\"http://secunia.com/advisories/42405\",\"name\":\"42405\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"]},{\"url\":\"http://xorl.wordpress.com/2010/09/21/cve-2010-0405-bzip2-integer-overflow/\",\"tags\":[\"x_refsource_CONFIRM\"]},{\"url\":\"https://bugzilla.redhat.com/show_bug.cgi?id=627882\",\"tags\":[\"x_refsource_CONFIRM\"]},{\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\"],\"name\":\"ADV-2010-3126\",\"url\":\"http://www.vupen.com/english/advisories/2010/3126\"},{\"name\":\"GLSA-201301-05\",\"tags\":[\"vendor-advisory\",\"x_refsource_GENTOO\"],\"url\":\"http://security.gentoo.org/glsa/glsa-201301-05.xml\"},{\"url\":\"http://www.vmware.com/security/advisories/VMSA-2010-0019.html\",\"tags\":[\"x_refsource_CONFIRM\"]},{\"url\":\"http://www.bzip.org/\",\"tags\":[\"x_refsource_CONFIRM\"]},{\"name\":\"ADV-2010-3127\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\"],\"url\":\"http://www.vupen.com/english/advisories/2010/3127\"},{\"name\":\"ADV-2010-3043\",\"tags\":[\"vdb-entry\",\"x_refsource_VUPEN\"],\"url\":\"http://www.vupen.com/english/advisories/2010/3043\"},{\"url\":\"http://lists.opensuse.org/opensuse-security-announce/2010-10/msg00000.html\",\"name\":\"SUSE-SR:2010:018\",\"tags\":[\"vendor-advisory\",\"x_refsource_SUSE\"]},{\"url\":\"http://secunia.com/advisories/42350\",\"name\":\"42350\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"]},{\"tags\":[\"x_refsource_CONFIRM\"],\"url\":\"http://support.apple.com/kb/HT4581\"}],\"problemTypes\":[{\"descriptions\":[{\"type\":\"text\",\"lang\":\"en\",\"description\":\"n/a\"}]}],\"providerMetadata\":{\"dateUpdated\":\"2018-10-10T18:57:01\",\"shortName\":\"mitre\",\"orgId\":\"8254265b-2729-46b6-b9e3-3dfca2d5bfca\"},\"x_legacyV4Record\":{\"affects\":{\"vendor\":{\"vendor_data\":[{\"product\":{\"product_data\":[{\"product_name\":\"n/a\",\"version\":{\"version_data\":[{\"version_value\":\"n/a\"}]}}]},\"vendor_name\":\"n/a\"}]}},\"data_type\":\"CVE\",\"data_format\":\"MITRE\",\"problemtype\":{\"problemtype_data\":[{\"description\":[{\"value\":\"n/a\",\"lang\":\"eng\"}]}]},\"description\":{\"description_data\":[{\"value\":\"Integer overflow in the BZ2_decompress function in decompress.c in bzip2 and libbzip2 before 1.0.6 allows context-dependent attackers to cause a denial of service (application crash) or possibly execute arbitrary code via a crafted compressed file.\",\"lang\":\"eng\"}]},\"data_version\":\"4.0\",\"references\":{\"reference_data\":[{\"url\":\"http://www.ubuntu.com/usn/USN-986-3\",\"name\":\"USN-986-3\",\"refsource\":\"UBUNTU\"},{\"refsource\":\"CONFIRM\",\"name\":\"http://git.clamav.net/gitweb?p=clamav-devel.git;a=blob_plain;f=ChangeLog;hb=clamav-0.96.3\",\"url\":\"http://git.clamav.net/gitweb?p=clamav-devel.git;a=blob_plain;f=ChangeLog;hb=clamav-0.96.3\"},{\"url\":\"http://lists.fedoraproject.org/pipermail/package-announce/2010-November/051278.html\",\"name\":\"FEDORA-2010-17439\",\"refsource\":\"FEDORA\"},{\"name\":\"USN-986-1\",\"refsource\":\"UBUNTU\",\"url\":\"http://www.ubuntu.com/usn/usn-986-1\"},{\"url\":\"http://www.ubuntu.com/usn/USN-986-2\",\"name\":\"USN-986-2\",\"refsource\":\"UBUNTU\"},{\"name\":\"41452\",\"refsource\":\"SECUNIA\",\"url\":\"http://secunia.com/advisories/41452\"},{\"url\":\"http://secunia.com/advisories/42404\",\"name\":\"42404\",\"refsource\":\"SECUNIA\"},{\"url\":\"http://secunia.com/advisories/48378\",\"refsource\":\"SECUNIA\",\"name\":\"48378\"},{\"url\":\"https://wwws.clamav.net/bugzilla/show_bug.cgi?id=2230\",\"refsource\":\"CONFIRM\",\"name\":\"https://wwws.clamav.net/bugzilla/show_bug.cgi?id=2230\"},{\"name\":\"ADV-2010-3073\",\"refsource\":\"VUPEN\",\"url\":\"http://www.vupen.com/english/advisories/2010/3073\"},{\"url\":\"http://www.vupen.com/english/advisories/2010/2455\",\"refsource\":\"VUPEN\",\"name\":\"ADV-2010-2455\"},{\"refsource\":\"APPLE\",\"name\":\"APPLE-SA-2011-03-21-1\",\"url\":\"http://lists.apple.com/archives/security-announce/2011/Mar/msg00006.html\"},{\"name\":\"42530\",\"refsource\":\"SECUNIA\",\"url\":\"http://secunia.com/advisories/42530\"},{\"url\":\"https://wwws.clamav.net/bugzilla/show_bug.cgi?id=2231\",\"name\":\"https://wwws.clamav.net/bugzilla/show_bug.cgi?id=2231\",\"refsource\":\"CONFIRM\"},{\"url\":\"http://marc.info/?l=oss-security&m=128506868510655&w=2\",\"name\":\"[oss-security] 20100921 bzip2 CVE-2010-0405 integer overflow\",\"refsource\":\"MLIST\"},{\"refsource\":\"SECUNIA\",\"name\":\"42529\",\"url\":\"http://secunia.com/advisories/42529\"},{\"name\":\"20101207 VMSA-2010-0019 VMware ESX third party updates for Service Console\",\"refsource\":\"BUGTRAQ\",\"url\":\"http://www.securityfocus.com/archive/1/515055/100/0/threaded\"},{\"name\":\"41505\",\"refsource\":\"SECUNIA\",\"url\":\"http://secunia.com/advisories/41505\"},{\"name\":\"ADV-2010-3052\",\"refsource\":\"VUPEN\",\"url\":\"http://www.vupen.com/english/advisories/2010/3052\"},{\"url\":\"http://www.redhat.com/support/errata/RHSA-2010-0703.html\",\"name\":\"RHSA-2010:0703\",\"refsource\":\"REDHAT\"},{\"url\":\"http://www.redhat.com/support/errata/RHSA-2010-0858.html\",\"refsource\":\"REDHAT\",\"name\":\"RHSA-2010:0858\"},{\"name\":\"FEDORA-2010-1512\",\"refsource\":\"FEDORA\",\"url\":\"http://lists.fedoraproject.org/pipermail/package-announce/2010-November/051366.html\"},{\"refsource\":\"CONFIRM\",\"name\":\"http://blogs.sun.com/security/entry/cve_2010_0405_integer_overflow\",\"url\":\"http://blogs.sun.com/security/entry/cve_2010_0405_integer_overflow\"},{\"url\":\"http://secunia.com/advisories/42405\",\"refsource\":\"SECUNIA\",\"name\":\"42405\"},{\"name\":\"http://xorl.wordpress.com/2010/09/21/cve-2010-0405-bzip2-integer-overflow/\",\"refsource\":\"CONFIRM\",\"url\":\"http://xorl.wordpress.com/2010/09/21/cve-2010-0405-bzip2-integer-overflow/\"},{\"name\":\"https://bugzilla.redhat.com/show_bug.cgi?id=627882\",\"refsource\":\"CONFIRM\",\"url\":\"https://bugzilla.redhat.com/show_bug.cgi?id=627882\"},{\"refsource\":\"VUPEN\",\"name\":\"ADV-2010-3126\",\"url\":\"http://www.vupen.com/english/advisories/2010/3126\"},{\"refsource\":\"GENTOO\",\"name\":\"GLSA-201301-05\",\"url\":\"http://security.gentoo.org/glsa/glsa-201301-05.xml\"},{\"url\":\"http://www.vmware.com/security/advisories/VMSA-2010-0019.html\",\"name\":\"http://www.vmware.com/security/advisories/VMSA-2010-0019.html\",\"refsource\":\"CONFIRM\"},{\"url\":\"http://www.bzip.org/\",\"name\":\"http://www.bzip.org/\",\"refsource\":\"CONFIRM\"},{\"refsource\":\"VUPEN\",\"name\":\"ADV-2010-3127\",\"url\":\"http://www.vupen.com/english/advisories/2010/3127\"},{\"refsource\":\"VUPEN\",\"name\":\"ADV-2010-3043\",\"url\":\"http://www.vupen.com/english/advisories/2010/3043\"},{\"url\":\"http://lists.opensuse.org/opensuse-security-announce/2010-10/msg00000.html\",\"refsource\":\"SUSE\",\"name\":\"SUSE-SR:2010:018\"},{\"url\":\"http://secunia.com/advisories/42350\",\"refsource\":\"SECUNIA\",\"name\":\"42350\"},{\"name\":\"http://support.apple.com/kb/HT4581\",\"refsource\":\"CONFIRM\",\"url\":\"http://support.apple.com/kb/HT4581\"}]},\"CVE_data_meta\":{\"STATE\":\"PUBLIC\",\"ID\":\"CVE-2010-0405\",\"ASSIGNER\":\"cve@mitre.org\"}}}},\"cveMetadata\":{\"assignerOrgId\":\"8254265b-2729-46b6-b9e3-3dfca2d5bfca\",\"dateReserved\":\"2010-01-27T00:00:00\",\"dateUpdated\":\"2024-08-07T00:45:12.275Z\",\"cveId\":\"CVE-2010-0405\",\"assignerShortName\":\"mitre\",\"datePublished\":\"2010-09-28T17:00:00\",\"state\":\"PUBLISHED\"}}",
159             # "cve_id" : "CVE-2010-0405",
160             # "distribution" : "Compress-Raw-Bzip2",
161             # "references" : [
162             # "https://metacpan.org/changes/distribution/Compress-Raw-Bzip2"
163             # ],
164             # "title" : "Integer overflow in the BZ2_decompress function in decompress.c in bzip2 and libbzip2 before 1.0.6 allows context-dependent attackers to cause a denial of service (application crash) or possibly execute arbitrary code via a crafted compressed file.\n",
165             # "version_range" : [ ]
166             # },
167             # { "affected_releases" : [ ],
168             # "cpansec_index" : "6a5ff392457db9df98944eb4d6b0b390b11e09d2",
169             # "cve" : "{\"cveMetadata\":{\"assignerOrgId\":\"53f830b8-0a3f-465b-8143-3b8a9948e749\",\"dateReserved\":\"2009-06-02T00:00:00\",\"dateUpdated\":\"2024-08-07T05:27:54.590Z\",\"cveId\":\"CVE-2009-1884\",\"datePublished\":\"2009-08-19T17:00:00\",\"assignerShortName\":\"redhat\",\"state\":\"PUBLISHED\"},\"containers\":{\"cna\":{\"problemTypes\":[{\"descriptions\":[{\"type\":\"text\",\"lang\":\"en\",\"description\":\"n/a\"}]}],\"references\":[{\"url\":\"http://secunia.com/advisories/36415\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"],\"name\":\"36415\"},{\"url\":\"https://www.redhat.com/archives/fedora-package-announce/2009-August/msg00999.html\",\"tags\":[\"vendor-advisory\",\"x_refsource_FEDORA\"],\"name\":\"FEDORA-2009-8888\"},{\"name\":\"FEDORA-2009-8868\",\"tags\":[\"vendor-advisory\",\"x_refsource_FEDORA\"],\"url\":\"https://www.redhat.com/archives/fedora-package-announce/2009-August/msg00982.html\"},{\"tags\":[\"x_refsource_CONFIRM\"],\"url\":\"https://bugzilla.redhat.com/show_bug.cgi?id=518278\"},{\"url\":\"http://www.securityfocus.com/bid/36082\",\"name\":\"36082\",\"tags\":[\"vdb-entry\",\"x_refsource_BID\"]},{\"url\":\"http://secunia.com/advisories/36386\",\"name\":\"36386\",\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\"]},{\"url\":\"http://security.gentoo.org/glsa/glsa-200908-07.xml\",\"tags\":[\"vendor-advisory\",\"x_refsource_GENTOO\"],\"name\":\"GLSA-200908-07\"},{\"name\":\"compressrawbzip2-bzinflate-dos(52628)\",\"tags\":[\"vdb-entry\",\"x_refsource_XF\"],\"url\":\"https://exchange.xforce.ibmcloud.com/vulnerabilities/52628\"},{\"url\":\"https://bugs.gentoo.org/show_bug.cgi?id=281955\",\"tags\":[\"x_refsource_CONFIRM\"]}],\"providerMetadata\":{\"orgId\":\"53f830b8-0a3f-465b-8143-3b8a9948e749\",\"shortName\":\"redhat\",\"dateUpdated\":\"2017-08-16T14:57:01\"},\"datePublic\":\"2009-08-18T00:00:00\",\"affected\":[{\"versions\":[{\"status\":\"affected\",\"version\":\"n/a\"}],\"product\":\"n/a\",\"vendor\":\"n/a\"}],\"descriptions\":[{\"lang\":\"en\",\"value\":\"Off-by-one error in the bzinflate function in Bzip2.xs in the Compress-Raw-Bzip2 module before 2.018 for Perl allows context-dependent attackers to cause a denial of service (application hang or crash) via a crafted bzip2 compressed stream that triggers a buffer overflow, a related issue to CVE-2009-1391.\"}]},\"adp\":[{\"providerMetadata\":{\"orgId\":\"af854a3a-2127-422b-91ae-364da2661108\",\"dateUpdated\":\"2024-08-07T05:27:54.590Z\",\"shortName\":\"CVE\"},\"title\":\"CVE Program Container\",\"references\":[{\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"],\"name\":\"36415\",\"url\":\"http://secunia.com/advisories/36415\"},{\"tags\":[\"vendor-advisory\",\"x_refsource_FEDORA\",\"x_transferred\"],\"name\":\"FEDORA-2009-8888\",\"url\":\"https://www.redhat.com/archives/fedora-package-announce/2009-August/msg00999.html\"},{\"name\":\"FEDORA-2009-8868\",\"tags\":[\"vendor-advisory\",\"x_refsource_FEDORA\",\"x_transferred\"],\"url\":\"https://www.redhat.com/archives/fedora-package-announce/2009-August/msg00982.html\"},{\"url\":\"https://bugzilla.redhat.com/show_bug.cgi?id=518278\",\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"]},{\"url\":\"http://www.securityfocus.com/bid/36082\",\"tags\":[\"vdb-entry\",\"x_refsource_BID\",\"x_transferred\"],\"name\":\"36082\"},{\"tags\":[\"third-party-advisory\",\"x_refsource_SECUNIA\",\"x_transferred\"],\"name\":\"36386\",\"url\":\"http://secunia.com/advisories/36386\"},{\"url\":\"http://security.gentoo.org/glsa/glsa-200908-07.xml\",\"tags\":[\"vendor-advisory\",\"x_refsource_GENTOO\",\"x_transferred\"],\"name\":\"GLSA-200908-07\"},{\"tags\":[\"vdb-entry\",\"x_refsource_XF\",\"x_transferred\"],\"name\":\"compressrawbzip2-bzinflate-dos(52628)\",\"url\":\"https://exchange.xforce.ibmcloud.com/vulnerabilities/52628\"},{\"url\":\"https://bugs.gentoo.org/show_bug.cgi?id=281955\",\"tags\":[\"x_refsource_CONFIRM\",\"x_transferred\"]}]}]},\"dataVersion\":\"5.1\",\"dataType\":\"CVE_RECORD\"}",
170             # "cve_id" : "CVE-2009-1884",
171             # "distribution" : "Compress-Raw-Bzip2",
172             # "references" : [
173             # "http://security.gentoo.org/glsa/glsa-200908-07.xml",
174             # "https://bugs.gentoo.org/show_bug.cgi?id=281955",
175             # "https://www.redhat.com/archives/fedora-package-announce/2009-August/msg00999.html",
176             # "https://www.redhat.com/archives/fedora-package-announce/2009-August/msg00982.html",
177             # "http://www.securityfocus.com/bid/36082",
178             # "http://secunia.com/advisories/36386",
179             # "https://bugzilla.redhat.com/show_bug.cgi?id=518278",
180             # "http://secunia.com/advisories/36415",
181             # "https://exchange.xforce.ibmcloud.com/vulnerabilities/52628"
182             # ],
183             # "title" : "Off-by-one error in the bzinflate function in Bzip2.xs in the Compress-Raw-Bzip2 module before 2.018 for Perl allows context-dependent attackers to cause a denial of service (application hang or crash) via a crafted bzip2 compressed stream that triggers a buffer overflow, a related issue to CVE-2009-1391.\n",
184             # "version_range" : [ ]
185             # }
186             # ],
187              
188 1 50       64 if (-s $src) {
189 0 0       0 open my $fh, "<", $src or croak "$src: $!\n";
190 0         0 local $/;
191 0         0 $self->{j}{db} = decode_json (<$fh>);
192 0         0 close $fh;
193             }
194             else {
195 1         12 my $r = HTTP::Tiny->new (verify_SSL => 1)->get ($src);
196 1 50       832816 $r->{success} or die "$src: $@\n";
197              
198 1 50       2826 $self->{verbose} > 1 and warn "Got it. Decoding\n";
199 1 50       18909 if (my $c = $r->{content}) {
200             # Skip warning part
201             # 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'
202             # {"Alien-PCRE2":[{"affected_versions":["<0.016000"],"cpansa_id":"CPANSA-Alien-PCRE2-2019-20454","cves":["CVE-2019-20454"],"description":"An out-
203 1 50       43 $c =~ s/^\s*([^{]+?)[\s\r\n]*\{/{/s and warn "$1\n";
204 1         280502 $self->{j}{db} = decode_json ($c);
205              
206             ### JSON strings to JSON structs in new format
207 1 50 33     15 if (ref $self->{j}{db} eq "HASH" and my @jk = sort keys %{$self->{j}{db}}) {
  1         538  
208 1         7 foreach my $k (@jk) {
209 319 50       453 foreach my $r (@{$self->{j}{db}{$k} || []}) {
  319         1101  
210 1731 100       5145 my $s = $r->{cve} or next;
211 1629 50       6353 ref $s and next;
212 0 0       0 $s =~ m/^{/ or next;
213 0         0 $r->{cve} = decode_json ($s);
214             }
215             }
216             }
217             }
218             else {
219 0         0 $self->{j}{db} = undef;
220             }
221             }
222 1   50     51 $self->{j}{mod} = [ sort keys %{$self->{j}{db} // {}} ];
  1         305  
223 1         26 $self;
224             } # _read_cpansa
225              
226             sub _read_MakefilePL {
227 11     11   7708 my ($self, $mf) = @_;
228 11   33     41 $mf ||= $self->{make_pl};
229              
230 11 50       33 $self->{verbose} and warn "Reading $mf ...\n";
231 11 50       163 open my $fh, "<", $mf or return $self;
232 11         21 my $mfc = do { local $/; <$fh> };
  11         41  
  11         84  
233 11         31 close $fh;
234              
235 11 50       30 $mfc or return $self;
236              
237 11         26 my ($pv, $release, $nm, $v, $vf) = ("");
238 11         193 foreach my $mfx (grep { m/=>/ }
  48         125  
239 43         195 map { split m/\s*[;(){}]\s*/ }
240 31         141 map { split m/\s*,(?!\s*=>)/ }
241             split m/[,;]\s*(?:#.*)?\r*\n/ => $mfc) {
242 28         151 $mfx =~ s/[\s\r\n]+/ /g;
243 28         97 $mfx =~ s/^\s+//;
244 28         81 $mfx =~ s/^(['"])(.*?)\1/$2/; # Unquote key
245 28         117 my $a = qr{\s* (?:,\s*)? => \s* (?|"([^""]*)"|'([^'']*)'|([-\w.]+))}x;
246 28 100 33     499 $mfx =~ m/^ VERSION $a /ix and $v //= $1;
247 28 50 0     323 $mfx =~ m/^ VERSION_FROM $a /ix and $vf //= $1;
248 28 100 33     365 $mfx =~ m/^ NAME $a /ix and $nm //= $1;
249 28 100 33     291 $mfx =~ m/^ DISTNAME $a /ix and $release //= $1;
250 28 100 33     397 $mfx =~ m/^ MIN_PERL_VERSION $a /ix and $pv ||= $1;
251             }
252              
253 11 50 66     66 unless ($release || $nm) {
254 0         0 carp "Cannot get either NAME or DISTNAME, so cowardly giving up\n";
255 0         0 return $self;
256             }
257 11 100       26 unless ($pv) {
258 8 50       51 $mfc =~ m/^\s*(?:use|require)\s+v?(5[.0-9]+)/m and $pv = $1;
259             }
260 11 100       78 $pv =~ m/^5\.(\d+)\.(\d+)$/ and $pv = sprintf "5.%03d%03d", $1, $2;
261 11 100       66 $pv =~ m/^5\.(\d{1,3})$/ and $pv = sprintf "5.%03d000", $1;
262              
263 11   66     52 $release //= $nm =~ s{-}{::}gr;
264 11 50 33     34 $release eq "." && $nm and $release = $nm =~ s{::}{-}gr;
265 11 0 33     29 if (!$v && $vf and open $fh, "<", $vf) {
      33        
266 0 0       0 warn "Trying to fetch VERSION from $vf ...\n" if $self->{verbose};
267 0         0 while (<$fh>) {
268 0 0       0 m/\b VERSION \s* = \s* ["']? ([^;'"\s]+) /x or next;
269 0         0 $v = $1;
270 0         0 last;
271             }
272 0         0 close $fh;
273             }
274 11 50       29 unless ($v) {
275 0 0       0 $mfc =~ m/\$\s*VERSION\s*=\s*["']?(\S+?)['"]?\s*;/ and $v = $1;
276             }
277 11 50       27 unless ($v) {
278 0         0 carp "Could not derive a VERSION from Makefile.PL\n";
279 0         0 carp "Please tell me where I did wrong\n";
280 0         0 carp "(ideally this should be done by a CORE module)\n";
281             }
282 11         71 $self->{mf} = { name => $nm, version => $v, release => $release, mpv => $pv };
283 11 0 0     35 $self->{verbose} and warn "Analysing for $release-", $v // "?", $pv ? " for minimum perl $pv\n" : "\n";
    50          
284 11   50     46 $self->{prereq}{$release}{v}{$v // "-"} = "current";
285 11         67 $self;
286             } # _read_MakefilePL
287              
288             sub _read_cpanfile {
289 1     1   777 my ($self, $cpf) = @_;
290 1   33     12 $cpf ||= $self->{cpanfile};
291              
292 1 50       64 -s $cpf or return; # warn "No cpanfile. Scan something else (Makefile.PL, META.json, ...\n";
293 1 50       6 $self->{verbose} and warn "Reading $cpf ...\n";
294 1 50       62 open my $fh, "<", $cpf or croak "$cpf: $!\n";
295 1         52 while (<$fh>) {
296 75 100       376 my ($t, $m, $v) = m{ \b
297             ( requires | recommends | suggest ) \s+
298             ["'] (\S+) ['"]
299             (?: \s*(?:=>|,)\s* ["'] (\S+) ['"])?
300             }x or next;
301 37         133 $m =~ s/::/-/g;
302 37   100     190 $self->{prereq}{$m}{v}{$v // ""} = $t;
303 37         82 $self->{prereq}{$m}{$t} = $v;
304              
305             # Ingnore syntax in cpanfile:
306             # require File::Temp, # ignore=CPANSA-File-Temp-2011-4116
307             # require File::Temp, # ignore : CVE-2011-4116
308 37 100       157 if (m/#.*\bignore\s*[=:]?\s*(\S+)/i) {
309 1         5 my $i = $1;
310 1         8 $self->{prereq}{$m}{i}{$i =~ s{["''"]+}{}gr}++;
311             }
312             }
313 1         3 push @{$self->{want}} => sort grep { $self->{j}{db}{$_} } keys %{$self->{prereq}};
  1         6  
  24         45  
  1         8  
314 1         26 $self;
315             } # _read_cpanfile
316              
317             sub _read_META {
318 0     0   0 my ($self, $mmf) = @_;
319 0 0   0   0 $mmf ||= first { length && -s }
320             $self->{meta_jsn}, "META.json",
321 0   0     0 $self->{meta_yml}, "META.yml",
322             "MYMETA.json", "MYMETA.yml";
323              
324 0 0 0     0 $mmf && -s $mmf or return;
325 0 0       0 $self->{verbose} and warn "Reading $mmf ...\n";
326 0 0       0 open my $fh, "<", $mmf or croak "$mmf: $!\n";
327 0         0 local $/;
328 0         0 my $j;
329 0 0       0 if ($mmf =~ m/\.yml$/) {
330 0         0 $self->{meta_yml} = $mmf;
331 0         0 $j = YAML::PP::Load (<$fh>);
332             $j->{prereqs} //= {
333             configure => {
334             requires => $j->{configure_requires},
335             recommends => $j->{configure_recommends},
336             suggests => $j->{configure_suggests},
337             },
338             build => {
339             requires => $j->{build_requires},
340             recommends => $j->{build_recommends},
341             suggests => $j->{build_suggests},
342             },
343             test => {
344             requires => $j->{test_requires},
345             recommends => $j->{test_recommends},
346             suggests => $j->{test_suggests},
347             },
348             runtime => {
349             requires => $j->{requires},
350             recommends => $j->{recommends},
351             suggests => $j->{suggests},
352             },
353 0   0     0 };
354             }
355             else {
356 0         0 $self->{meta_jsn} = $mmf;
357 0         0 $j = decode_json (<$fh>);
358             }
359 0         0 close $fh;
360              
361 0 0       0 unless ($self->{mf}) {
362 0         0 my $rls = $self->{mf}{release} = $j->{name} =~ s{::}{-}gr;
363 0         0 my $vsn = $self->{mf}{version} = $j->{version};
364 0         0 my $nm = $self->{mf}{name} = $j->{name} =~ s{-}{::}gr;
365 0   0     0 $self->{prereq}{$rls}{v}{$vsn // "-"} = "current";
366             }
367 0   0     0 $self->{mf}{mpv} ||= $j->{prereqs}{runtime}{requires}{perl};
368              
369 0 0       0 my $pr = $j->{prereqs} or return $self;
370 0         0 foreach my $p (qw( configure build test runtime )) {
371 0         0 foreach my $t (qw( requires recommends suggests )) {
372 0 0       0 my $x = $pr->{$p}{$t} or next;
373 0         0 foreach my $m (keys %$x) {
374 0         0 my $v = $x->{$m};
375 0         0 $m =~ s/::/-/g;
376 0   0     0 $self->{prereq}{$m}{v}{$v // ""} = $t;
377 0         0 $self->{prereq}{$m}{$t} = $v;
378             }
379             }
380             }
381 0         0 push @{$self->{want}} => sort grep { $self->{j}{db}{$_} } keys %{$self->{prereq}};
  0         0  
  0         0  
  0         0  
382 0         0 $self;
383             } # _read_META
384              
385             sub set_meta {
386 0     0 1 0 my ($self, $m, $v) = @_;
387             $self->{mf} = {
388 0   0     0 name => $m,
389             release => $m =~ s{::}{-}gr,
390             version => $v // "-",
391             };
392 0         0 $self;
393             } # set_meta
394              
395             sub want {
396 2     2 1 18 my ($t, $self, $m, $v) = ("requires", @_);
397 2         11 $m =~ s/::/-/g;
398 2 50   2   12 unless (first { $_ eq $m } @{$self->{want}}) {
  2         10  
  2         19  
399 2   50     28 $self->{prereq}{$m}{v}{$v // ""} = $t;
400 2         8 $self->{prereq}{$m}{$t} = $v;
401 2 100       11 $self->{j} or $self->_read_cpansa;
402 2 100       12 $self->{j}{db}{$m} and push @{$self->{want}} => $m;
  1         5  
403             }
404 2         18 $self;
405             } # want
406              
407             sub test {
408 0     0 1   my $self = shift;
409 0           my $meta = 0;
410              
411 0 0         $self->{mf} or $self->_read_MakefilePL;
412 0 0 0       $self->{mf} or $self->_read_META && $meta++;
413 0 0         my $rel = $self->{mf}{release} or return $self;
414 0 0         $self->{verbose} and warn "Processing for $self->{mf}{release} ...\n";
415              
416 0 0         $self->{j}{mod} or $self->_read_cpansa;
417 0 0 0       @{$self->{want}} or $self->_read_cpanfile if $self->{deps};
  0            
418 0 0 0       @{$self->{want}} or $self->_read_META if $self->{deps} && !$meta;
  0   0        
419 0 0 0       @{$self->{want}} or $self->_read_META ("META.json") if $self->{deps};
  0            
420              
421 0 0         $self->{j}{db}{$rel} and unshift @{$self->{want}} => $rel;
  0            
422              
423 0           $self->{want} = [ uniq @{$self->{want}} ];
  0            
424              
425 0 0         my @w = @{$self->{want}} or return $self; # Nothing to report
  0            
426              
427 0           foreach my $m (@w) {
428 0 0 0       $m eq "perl" && !$self->{perl} and next;
429              
430 0 0         my @mv = sort map { $_ || 0 } keys %{$self->{prereq}{$m}{v} || {}};
  0 0          
  0            
431 0 0 0       if ($self->{core} and my $pv = $self->{mf}{mpv}
      0        
432             and "@mv" !~ m/[1-9]/) {
433 0   0       my $pmv = $Module::CoreList::version{$pv}{$m =~ s/-/::/gr} // "";
434 0 0         $pmv and @mv = ($pmv =~ s/\d\K_.*//r);
435             }
436 0 0         $self->{verbose} and warn "$m: ", join (" / " => grep { $_ } @mv), "\n";
  0            
437 0   0       my $cv = ($self->{minimum} ? $mv[0] : $mv[-1]) || 0; # Minimum or recommended
438             $self->{CVE}{$m} = {
439             mod => $m,
440             vsn => $self->{prereq}{$m}{t},
441 0           min => $cv,
442             cve => [],
443             };
444              
445             #DDumper $self->{j}{db}{$m};
446 0           foreach my $c (@{$self->{j}{db}{$m}}) {
  0            
447             # Ignored: references
448 0           my $cid = $c->{cpansa_id};
449 0   0       my $cds = $c->{cves} || $c->{cve} || [];
450 0 0         if (ref $cds ne "ARRAY") {
451 0 0         $cds =~ m/^{/ and $cds = decode_json ($cds);
452             #use DP;die DDumper $cds;
453             }
454 0           my @cve = @$cds;
455 0           @cve = grep { !exists $self->{skip}{$_} } @cve;
  0            
456 0           my $dte = $c->{reported};
457 0           my $sev = $c->{severity};
458 0           my $dsc = $c->{description};
459 0 0         my @vsn = @{$c->{affected_versions} || []};
  0            
460 0 0         if (my $i = $self->{prereq}{$m}{i}) {
461 0           my $p = join "|" => reverse sort keys %$i;
462 0           my $m = join "#" => sort @cve, $cid;
463 0 0         "#$m#" =~ m/$p/ and next;
464             }
465 0 0         if (@vsn) {
466 0 0         $self->{verbose} > 2 and warn "CMP<: $m-$cv\n";
467 0 0         $self->{verbose} > 4 and warn "VSN : (@vsn)\n";
468             # >=5.30.0,<5.34.3,>=5.36.0,<5.36.3,>=5.38.0,<5.38.2
469             my $cmp = join " or " =>
470 0           map { s/\s*,\s*/") && XV /gr
  0            
471             =~ s/^/XV /r
472             =~ s/\s+=(?=[^=<>])\s*/ == /r # = => ==
473             =~ s/\s*([=<>]+)\s*/$1 version->parse ("/gr
474             =~ s/$/")/r
475             =~ s/\bXV\b/version->parse ("$cv")/gr
476             =~ s/\)\K(?=\S)/ /gr
477             } @vsn;
478 0 0         $self->{verbose} > 2 and warn "CMP>: $cmp\n";
479 0 0         eval "$cmp ? 0 : 1" and next;
480 0 0         $self->{verbose} > 3 and warn "TAKE!\n";
481             }
482             else {
483 0           warn "Oops: NO V or CVE?\n";
484             #use DP;DDumper $c->{cve};
485             }
486 0           push @{$self->{CVE}{$m}{cve}} => {
  0            
487             cid => $cid,
488             dte => $dte,
489             cve => [ @cve ],
490             sev => $sev,
491             av => [ @vsn ],
492             dsc => $dsc,
493             };
494             #die DDumper { c => $c, cv => $cv, cve => $self->{CVE}{$m}, vsn => \@vsn };
495             }
496             }
497 0           $self;
498             } # test
499              
500             sub report {
501 0     0 1   my $self = shift;
502              
503 0 0         $self->{j} or return;
504              
505 0 0         @_ % 2 and croak "Uneven number of arguments";
506 0           my %args = @_;
507              
508 0   0       local $Text::Wrap::columns = ($args{width} || $self->{width}) - 4;
509              
510 0           my $n;
511 0           foreach my $m (@{$self->{want}}) {
  0            
512 0 0         my $C = $self->{CVE}{$m} or next;
513 0 0         my @c = @{$C->{cve}} or next;
  0            
514 0   0       say "$m: ", $C->{min} // "-";
515 0           foreach my $c (@c) {
516 0   0       my $cve = "@{$c->{cve}}" || $c->{cid};
517             printf " %-10s %-12s %-12s %s\n",
518 0   0       $c->{dte}, "@{$c->{av}}", $c->{sev} // "-", $cve;
  0            
519 0           print s/^/ /gmr for wrap ("", "", $c->{dsc});
520 0           $n++;
521             }
522             }
523 0 0         $n or say "There heve been no CVE detections in this process";
524             } # report
525              
526             sub cve {
527 0     0 1   my $self = shift;
528              
529 0 0         $self->{j} or return;
530              
531 0 0         @_ % 2 and croak "Uneven number of arguments";
532 0           my %args = @_;
533              
534 0   0       local $Text::Wrap::columns = $args{width} || $self->{width};
535              
536 0           my @cve;
537 0           foreach my $m (@{$self->{want}}) {
  0            
538 0 0         my $C = $self->{CVE}{$m} or next;
539 0 0         my @c = @{$C->{cve}} or next;
  0            
540 0           push @cve => { release => $m, vsn => $C->{min}, cve => [ @c ] };
541             }
542 0           @cve;
543             } # cve
544              
545             sub has_no_cves {
546 0     0 1   my %attr = @_;
547 0           my $tb = __PACKAGE__->builder;
548              
549             # By default skip this test is not in a development env
550 0 0 0       if (!exists $attr{author} and
      0        
551             ((caller)[1] =~ m{(?:^|/)xt/[^/]+\.t$} or
552             $ENV{AUTHOR_TESTING} or
553             -d ".git" && $^X =~ m{/perl$})) {
554 0           $attr{author}++;
555             }
556 0 0         unless ($attr{author}) {
557 0           $tb->ok (1, "CVE tests skipped: no author environment");
558 0           return;
559             }
560              
561 0   0       $attr{perl} //= 0;
562              
563 0           my $cve = Test::CVE->new (@_);
564 0           $cve->test;
565 0           my @cve = $cve->cve;
566 0 0         if (@cve) {
567 0           $tb->ok (0, "This release found open CVEs");
568 0           foreach my $r (@cve) {
569 0           my ($m, $v) = ($r->{release}, $r->{vsn});
570 0           foreach my $c (@{$r->{cve}}) {
  0            
571 0           my $cve = join ", " => @{$c->{cve}};
  0            
572 0           my $av = join " & " => @{$c->{av}};
  0            
573 0           $tb->diag (0, "$m-$v : $cve for $av");
574             }
575             }
576             }
577             else {
578 0           $tb->ok (1, "This release found no open CVEs");
579             }
580             } # has_no_cves
581              
582             1;
583              
584             __END__