File Coverage

blib/lib/Net/CVE.pm
Criterion Covered Total %
statement 145 153 94.7
branch 54 88 61.3
condition 10 18 55.5
subroutine 23 23 100.0
pod 9 10 90.0
total 241 292 82.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Net::CVE;
4              
5 6     6   623738 use 5.014002;
  6         47  
6 6     6   38 use warnings;
  6         14  
  6         238  
7              
8             our $VERSION = "0.005"; # 20230531
9              
10 6     6   37 use Carp;
  6         11  
  6         429  
11 6     6   4395 use HTTP::Tiny;
  6         262090  
  6         248  
12 6     6   2887 use JSON::MaybeXS;
  6         47514  
  6         360  
13 6     6   48 use List::Util qw( first );
  6         16  
  6         11486  
14              
15             # https://cveawg.mitre.org/api/cve/CVE-2022-26928
16             # But that is likely to change to cve.org
17              
18 1     1 0 5 sub Version { $VERSION }
19              
20             sub new {
21 21     21 1 4200 my $class = shift;
22 21         121 my %r = (
23             url => "https://cveawg.mitre.org/api/cve",
24             ua => undef,
25             lang => "en",
26             data => {},
27             diag => undef,
28             );
29 21 100       79 if (@_) {
30 6 100 66     37 if (@_ == 1 && ref $_[0] eq "HASH") {
    50          
31 1         2 $r{$_} = $_[0]{$_} for keys %{$_[0]};
  1         6  
32             }
33             elsif (@_ == 2) {
34 5         13 my %p = @_;
35 5         29 $r{$_} = $p{$_} for keys %p;
36             }
37             }
38 21         103 bless \%r => $class;
39             } # new
40              
41             sub diag {
42 4 50   4 1 19 my $self = shift or return;
43 4 50       13 ref $self or return;
44 4 50       13 my $d = $self->{diag} or return;
45 4 50       12 unless (defined wantarray) { # void context
46 0         0 my $act = $d->{action};
47             warn "$act: ",
48 0         0 (join " " => grep { length } $d->{status}, $d->{reason}), "\n";
  0         0  
49 0         0 $act =~ s/./ /g;
50 0 0       0 warn "$act source = $d->{source}\n" if $d->{source};
51 0 0       0 warn "$act usage: $d->{usage}\n" if $d->{usage};
52             }
53 4         31 return $d;
54             } # diag
55              
56             sub get {
57 19     19 1 59 my ($self, $cve) = @_;
58 19 100       73 ref $self or $self = __PACKAGE__->new ();
59 19         53 $self->{data} = {};
60 19         50 $self->{diag} = undef;
61 19 100       55 $cve or return $self;
62 18         73 $cve =~ s/^(?=[0-9])/CVE-/;
63 18 100       336 if ($cve =~ m/^CVE-[0-9]{4}-([0-9]+)$/) {
    100          
64 5   33     56 $self->{ua} //= HTTP::Tiny->new ();
65 5         595 my $url = join "/" => $self->{url}, $cve;
66 5         158 my $r = $self->{ua}->get ($url);
67 5 100       1991088 unless ($r->{success}) {
68             # if pseudo-HTTP status code 599 and reason "Internal Exception"
69             # the content field will contain the text of the error
70 1         4 my $status = $r->{status};
71 2         9 my $reason = join ": " => grep { length }
72 1 50       12 $r->{reason}, $status =~ m/^5[0-9][0-9]$/ ? $r->{content} : "";
73             $self->{diag} = {
74 1         8 status => $status,
75             reason => $reason,
76             action => "get",
77             source => $url,
78             usage => undef,
79             };
80 1         7 return $self;
81             }
82 4         513 $self->{data} = decode_json ($r->{content});
83             }
84             elsif (-s $cve) {
85 12         29 my $fh;
86 12 50   4   454 unless (open $fh, "<:encoding(utf-8)", $cve) {
  4         32  
  4         7  
  4         31  
87             $self->{diag} = {
88 0         0 status => 0 + $!,
89             reason => "$!",
90             action => "get",
91             source => $cve,
92             usage => 'get ("cve-2022-26928.json")',
93             };
94 0         0 return $self;
95             }
96 12 100       46716 unless (eval { $self->{data} = decode_json (do { local $/; <$fh> }); 1 }) {
  12         22  
  12         48  
  12         483  
  10         1295  
97             $self->{diag} = {
98 2         130 status => -2,
99             reason => $@ =~ s{\s+at\s+\S+\s+line\s+\d+.*}{}rs,
100             action => "decode_json",
101             source => $cve,
102             usage => undef,
103             };
104 2         78 return $self;
105             }
106 10         164 close $fh;
107             }
108             else {
109             #warn "Invalid CVE format: '$cve' - expected format CVE-2023-12345\n";
110             $self->{diag} = {
111 1         20 status => -1,
112             reason => "Invalid CVE format: '$cve'",
113             action => "get",
114             source => "tag",
115             usage => 'get ("CVE-2022-26928")',
116             };
117 1         4 return $self;
118             }
119 14         99 $self;
120             } # get
121              
122             sub data {
123 8     8 1 22 my $self = shift;
124 8 100       30 ref $self or $self = __PACKAGE__->new ();
125 8 100       38 @_ and $self->get (@_);
126 8         53 $self->{data};
127             } # data
128              
129             sub summary {
130 10     10 1 25 my $self = shift;
131 10 100       38 ref $self or $self = __PACKAGE__->new ();
132 10 100       39 @_ and $self->get (@_);
133 10 50       32 my $j = $self->{data} or croak "summary only available after get";
134 10 50       30 my $cna = $j->{containers}{cna} or return +{};
135             #y $weak = ... weaknesses [{ description [{ lang => "en", value => "CWE-123"}]
136              
137 10 50       20 my $severity = join ", " => grep { length } map { $_->{cvssV3_1}{baseSeverity} } @{$cna->{metrics} || []};
  10         35  
  10         44  
  10         34  
138 10 50       22 my $score = join ", " => grep { length } map { $_->{cvssV3_1}{baseScore} } @{$cna->{metrics} || []};
  10         29  
  10         26  
  10         32  
139              
140 10         20 my %desc;
141 10 50       16 for (@{$cna->{descriptions} || []}) {
  10         34  
142 30 50       64 my $d = $_->{value} or next;
143 30         46 push @{$desc{$_->{lang}}} => $d;
  30         85  
144             }
145 10         52 my @lang = sort keys %desc;
146 10     15   80 my $lang = first { m/\b $self->{lang} /ix } @lang;
  15         154  
147 10   66 1   56 $lang //= first { m/\b en /ix } @lang;
  1         6  
148 10   33     29 $lang //= $lang[0];
149 10         19 my $desc = join "\n" => @{$desc{$lang}};
  10         32  
150              
151 10         18 my %problem;
152 10 50       17 for (map { @{$_->{descriptions} || []} } @{$cna->{problemTypes} || []}) {
  10 50       18  
  10         43  
  10         32  
153 22 50       58 my $d = $_->{description} or next;
154 22         28 push @{$problem{$_->{lang}}} => $d;
  22         60  
155             }
156 10         61 @lang = sort keys %problem;
157 10     13   60 $lang = first { m/\b $self->{lang} /ix } @lang;
  13         99  
158 10   66 4   55 $lang //= first { m/\b en /ix } @lang;
  4         13  
159 10   66     28 $lang //= $lang[0];
160 10         16 my $problem = join "\n" => @{$problem{$lang}};
  10         28  
161              
162             { id => $j->{cveMetadata}{cveId},
163             date => $j->{cveMetadata}{datePublished},
164 10         52 description => $desc,
165             severity => lc $severity,
166             score => $score,
167             problem => $problem,
168             product => [ $self->product ],
169             vendor => [ $self->vendor ],
170             platforms => [ $self->platforms ],
171             status => $self->status,
172             };
173             } # summary
174              
175             sub status {
176 10     10 1 18 my $self = shift;
177 10 50       33 @_ and $self->get (@_);
178 10 50       32 my $j = $self->{data} or croak "status only available after get";
179 10         151 $j->{cveMetadata}{state};
180             } # status
181              
182             sub _affected_tag {
183 20     20   43 my ($self, $tag) = @_;
184 20 50       50 my $j = $self->{data} or croak "$tag only available after get";
185 20 50       47 my $cna = $j->{containers}{cna} or return;
186 20 50       30 my %v = map { $_->{$tag} => 1 } @{$cna->{affected} || []};
  128         258  
  20         57  
187 20         95 my @v = sort keys %v;
188 20 50       132 return wantarray ? @v : join ", " => @v;
189             } # _affected_tag
190              
191             sub _affected_tag_a {
192 10     10   21 my ($self, $tag) = @_;
193 10 50       24 my $j = $self->{data} or croak "$tag only available after get";
194 10 50       24 my $cna = $j->{containers}{cna} or return;
195 124 50       191 my %v = map { $_ => 1 } map { @{$_ || []} } map { $_->{$tag} }
  64         80  
  64         142  
  64         100  
196 10 50       17 @{$cna->{affected} || []};
  10         27  
197 10         51 my @v = sort keys %v;
198 10 50       59 return wantarray ? @v : join ", " => @v;
199             } # _affected_tag_a
200              
201             sub platforms {
202 10     10 1 19 my $self = shift;
203 10 50       25 @_ and $self->get (@_);
204 10         26 $self->_affected_tag_a ("platforms");
205             } # platforms
206              
207             sub vendor {
208 10     10 1 19 my $self = shift;
209 10 50       27 @_ and $self->get (@_);
210 10         21 $self->_affected_tag ("vendor");
211             } # vendor
212              
213             sub product {
214 10     10 1 17 my $self = shift;
215 10 50       30 @_ and $self->get (@_);
216 10         1094 $self->_affected_tag ("product");
217             } # vendor
218              
219             1;
220              
221             __END__
222              
223             =head1 NAME
224              
225             Net::CVE - Fetch CVE (Common Vulnerabilities and Exposures) information from cve.org
226              
227             =head1 SYNOPSIS
228              
229             use Net::CVE;
230              
231             my $cr = Net::CVE->new ();
232              
233             $cr->get ("CVE-2022-26928");
234             my $full_report = $cr->data;
235             my $summary = $cr->summary;
236              
237             $cr->diag;
238              
239             use Data::Peek;
240             DDumper $cr->summary ("CVE-2022-26928");
241              
242             =head1 DESCRIPTION
243              
244             This module provides a Perl interface to retrieve information from the
245             L<CVE database|https://www.cve.org/Downloads> provided by L<https://cve.org>
246             based on a CVE tag.
247              
248             =head1 METHODS
249              
250             =head2 new
251              
252             my $reporter = CVE->new (
253             url => "https://cveawg.mitre.org/api/cve",
254             ua => undef,
255             lang => "en",
256             );
257              
258             Instantiates a new object. All attributes are optional.
259              
260             =over 2
261              
262             =item url
263              
264             Base url for REST API
265              
266             =item ua
267              
268             User agent. Needs to know about C<< ->get >>. Defaults to L<HTTP::Tiny>.
269             Initialized on first use.
270              
271             my $reporter = CVE->new (ua => HTTP::Tiny->new);
272              
273             Other agents not yet tested, so they might fail.
274              
275             =item lang
276              
277             Set preferred language for L</summary>. Defaults to C<en>.
278              
279             If the preferred language is present in descriptions use that. If it is not, use
280             C<en>. If that is also not present, use the first language found.
281              
282             =back
283              
284             =head2 get
285              
286             $reporter->get ("CVE-2022-26928");
287             $reporter->get ("2022-26928");
288             $reporter->get ("Files/CVE-2022-26928.json");
289              
290             Fetches the CVE data for a given tag. On success stores the results internally.
291             Returns the object. The leading C<CVE-> is optional.
292              
293             If the argument is a non-empty file, that is parsed instead of fetching the
294             information from the internet.
295              
296             The decoded information is stored internally and will be re-used for other
297             methods.
298              
299             C<get> returns the object and allows to omit a call to C<new> which will be
300             implicit but does not allow attributes
301              
302             my $reporter = Net::CVE->get ("2022-26928");
303              
304             is a shortcut to
305              
306             my $reporter = Net::CVE->new->get ("2022-26928");
307              
308             =head2 data
309              
310             my $info = $reporter->data;
311              
312             Returns the data structure from the last successful fetch, C<undef> if none.
313              
314             Giving an argument enables you to skip the L</get> call, which is implicit, so
315              
316             my $info = $reporter->data ("CVE-2022-26928");
317              
318             is identical to
319              
320             my $info = $reporter->get ("CVE-2022-26928")->data;
321              
322             or
323              
324             $reporter->get ("CVE-2022-26928");
325             my $info = $reporter->data;
326              
327             or even, whithout an object
328              
329             my $info = Net::CVE->data ("CVE-2022-26928");
330              
331             =head2 summary
332              
333             my $info = $reporter->summary;
334             my $info = $reporter->summary ("CVE-2022-26928");
335              
336             Returns a hashref with basic information from the last successful fetch,
337             C<undef> if none.
338              
339             Giving an argument enables you to skip the L</get> call, which is implicit, so
340              
341             my $info = $reporter->summary ("CVE-2022-26928");
342              
343             is identical to
344              
345             my $info = $reporter->get ("CVE-2022-26928")->summary;
346              
347             or
348              
349             $reporter->get ("CVE-2022-26928");
350             my $info = $reporter->summary;
351              
352             or even, whithout an object
353              
354             my $info = Net::CVE->summary ("CVE-2022-26928");
355              
356             The returned hash looks somewhat like this
357              
358             { date => "2022-09-13T18:41:25",
359             description => "Windows Photo Import API Elevation of Privilege Vulnerability",
360             id => "CVE-2022-26928",
361             problem => "Elevation of Privilege",
362             score => "7",
363             severity => "high",
364             status => "PUBLISHED",
365             vendor => [ "Microsoft" ]
366             platforms => [ "32-bit Systems",
367             "ARM64-based Systems",
368             "x64-based Systems",
369             ],
370             product => [
371             "Windows 10 Version 1507",
372             "Windows 10 Version 1607",
373             "Windows 10 Version 1809",
374             "Windows 10 Version 20H2",
375             "Windows 10 Version 21H1",
376             "Windows 10 Version 21H2",
377             "Windows 11 version 21H2",
378             "Windows Server 2016",
379             "Windows Server 2019",
380             "Windows Server 2022",
381             ],
382             }
383              
384             As this is work in progress, likely to be changed
385              
386             =head2 status
387              
388             my $status = $reporter->status;
389              
390             Returns the status of the CVE, most likely C<PUBLISHED>.
391              
392             =head2 vendor
393              
394             my @vendor = $reporter->vendor;
395             my $vendors = $reporter->vendor;
396              
397             Returns the list of vendors for the affected parts of the CVE. In scalar
398             context a string where the (sorted) list of unique vendors is joined by
399             C<, > in list context the (sorted) list itself.
400              
401             =head2 product
402              
403             my @product = $reporter->product;
404             my $products = $reporter->product;
405              
406             Returns the list of products for the affected parts of the CVE. In scalar
407             context a string where the (sorted) list of unique products is joined by
408             C<, > in list context the (sorted) list itself.
409              
410             =head2 platforms
411              
412             my @platform = $reporter->platforms;
413             my $platforms = $reporter->platforms;
414              
415             Returns the list of platforms for the affected parts of the CVE. In scalar
416             context a string where the (sorted) list of unique platforms is joined by
417             C<, > in list context the (sorted) list itself.
418              
419             =head2 diag
420              
421             $reporter->diag;
422             my $diag = $reporter->diag;
423              
424             If an error occured, returns information about the error. In void context
425             prints the diagnostics using C<warn>. The diagnostics - if any - will be
426             returned in a hashref with the following fields:
427              
428             =over 2
429              
430             =item status
431              
432             Status code
433              
434             =item reason
435              
436             Failure reason
437              
438             =item action
439              
440             Tag of where the failure occured
441              
442             =item source
443              
444             The URL or filename leading to the failure
445              
446             =item usage
447              
448             Help message
449              
450             =back
451              
452             Only the C<action> field is guaranteed to be set, all others are optional.
453              
454             =head1 BUGS
455              
456             None so far
457              
458             =head1 TODO
459              
460             =over 2
461              
462             =item Better error reporting
463              
464             Obviously
465              
466             =item Tests
467              
468             There are none yet
469              
470             =item Meta-stuff
471              
472             Readme, Changelog, Makefile.PL, ...
473              
474             =item Fallback to Net::NVD
475              
476             Optionally. It does not (yet) provide vendor, product and platforms.
477             It however provides nice search capabilities.
478              
479             =item RHSA support
480              
481             Extend to return results for C<RHSA-2023:1791> type vulnerability tags.
482              
483             https://access.redhat.com/errata/RHSA-2023:1791
484             https://access.redhat.com/hydra/rest/securitydata/crf/RHSA-2023:1791.json
485              
486             The CRF API provides the list of CVE's related to this tag:
487              
488             my $url = "https://access.redhat.com/hydra/rest/securitydata/crf";
489             my $crf = decode_json ($ua->get ("$url/RHSA-2023:1791.json"));
490             my @cve = map { $_->{cve} }
491             @{$crf->{cvrfdoc}{vulnerability} || []}
492              
493             Will set C<@cve> to
494              
495             qw( CVE-2023-1945 CVE-2023-1999 CVE-2023-29533 CVE-2023-29535
496             CVE-2023-29536 CVE-2023-29539 CVE-2023-29541 CVE-2023-29548
497             CVE-2023-29550 );
498              
499             See L<the API documentation|https://access.redhat.com/documentation/en-us/red_hat_security_data_api/1.0/html-single/red_hat_security_data_api/index>.
500              
501             =back
502              
503             =head1 SEE ALSO
504              
505             =over 2
506              
507             =item CVE search
508              
509             L<https://cve.org> and L<https://cve.mitre.org/cve/search_cve_list.html>
510              
511             =item L<Net::OSV>
512              
513             Returns OpenSource Vulnerabilities.
514              
515             =item CVE database
516              
517             L<https://www.cvedetails.com/>
518              
519             =back
520              
521             =head1 AUTHOR
522              
523             H.Merijn Brand <hmbrand@cpan.org>
524              
525             =head1 COPYRIGHT AND LICENSE
526              
527             Copyright (C) 2023-2023 H.Merijn Brand
528              
529             This library is free software; you can redistribute it and/or modify
530             it under the same terms as Perl itself. See L<perlartistic>.
531              
532             This interface uses data from the CVE API but is not endorsed by any
533             of the CVE partners.
534              
535             =head1 DISCLAIMER OF WARRANTY
536              
537             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
538             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
539             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
540             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
541             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
542             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
543             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
544             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
545             NECESSARY SERVICING, REPAIR, OR CORRECTION.
546              
547             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
548             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
549             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE
550             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
551             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
552             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
553             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
554             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
555             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
556             SUCH DAMAGES.
557              
558             =cut