File Coverage

blib/lib/CVSS/Base.pm
Criterion Covered Total %
statement 131 166 78.9
branch 33 56 58.9
condition 12 20 60.0
subroutine 30 53 56.6
pod 28 38 73.6
total 234 333 70.2


line stmt bran cond sub pod time code
1             package CVSS::Base;
2              
3 6     6   44 use feature ':5.10';
  6         8  
  6         642  
4 6     6   62 use strict;
  6         23  
  6         123  
5 6     6   23 use utf8;
  6         7  
  6         43  
6 6     6   200 use warnings;
  6         7  
  6         270  
7              
8 6     6   24 use Carp ();
  6         23  
  6         432  
9              
10             our $VERSION = '1.15';
11             $VERSION =~ tr/_//d; ## no critic
12              
13 6     6   2379 use overload '""' => \&to_string, fallback => 1;
  6         6428  
  6         54  
14              
15 6     6   566 use constant DEBUG => $ENV{CVSS_DEBUG};
  6         8  
  6         933  
16              
17             sub import {
18              
19 13     13   2414 my $class = shift;
20              
21 13         45 my $ATTRIBUTES = $class->ATTRIBUTES;
22              
23 13         26 for my $method (keys %{$ATTRIBUTES}) {
  13         96  
24              
25 6     6   73 no strict 'refs';
  6         20  
  6         247  
26 6     6   26 no warnings 'uninitialized';
  6         8  
  6         360  
27 6     6   34 no warnings 'redefine';
  6         7  
  6         18190  
28              
29 294         387 my $metric = $ATTRIBUTES->{$method};
30              
31             # Long method name
32 294         802 *{"${class}::${method}"} = sub {
33 16 100   16   72 @_ > 1 ? $_[0]->_metric_name_to_value($metric, $_[1]) : $_[0]->_metric_value_to_name($metric);
34 294         1007 };
35              
36             # Create metric alias
37 294     0   943 *{"${class}::${metric}"} = sub { $_[0]->M($metric) };
  294         8520  
  0         0  
38              
39             }
40              
41             }
42              
43             sub new {
44              
45 4255     4255 0 141088 my ($class, %params) = @_;
46              
47 4255   100     9439 $params{metrics} //= {};
48 4255   50     18868 $params{scores} //= {};
49 4255   100     7951 $params{vector_string} //= undef;
50              
51 4255         16144 my $self = bless {%params}, $class;
52              
53 4255 50       12372 if ($self->version !~ /(2.0|3.[0-1]|4.0)/) {
54 0         0 Carp::croak 'Invalid CVSS version';
55             }
56              
57 4255 100       9775 if ($self->{vector_string}) {
58              
59 4254         5022 DEBUG and say STDERR sprintf('-- Validate vector string: %s', $self->VECTOR_STRING_REGEX);
60              
61 4254 50       10822 if ($self->{vector_string} !~ $self->VECTOR_STRING_REGEX) {
62 0         0 Carp::croak 'Invalid CVSS vector string';
63             }
64              
65 4254         11313 $self->calculate_score;
66              
67             }
68              
69 4255         17052 return $self;
70              
71             }
72              
73             sub from_vector_string {
74              
75 4252     4252 0 2851596 my ($class, $vector_string) = @_;
76              
77 4252         65654 my %metrics = split /[\/:]/, $vector_string;
78 4252   100     18245 my $version = delete $metrics{CVSS} || '2.0';
79              
80 4252         4954 DEBUG and say STDERR "-- Vector String: $vector_string";
81 4252         11919 return $class->new(version => $version, metrics => \%metrics, vector_string => $vector_string);
82              
83             }
84              
85 0     0 1 0 sub ATTRIBUTES { {} }
86 0     0 1 0 sub SCORE_SEVERITY { {} }
87       0 1   sub NOT_DEFINED_VALUE { }
88 0     0 1 0 sub VECTOR_STRING_REGEX {qw{}}
89 0     0 1 0 sub METRIC_GROUPS { {} }
90 0     0 1 0 sub METRIC_NAMES { {} }
91 0     0 1 0 sub METRIC_VALUES { {} }
92              
93              
94             sub _metric_name_to_value {
95 8     8   14 my ($self, $metric, $name) = @_;
96 8         12 $name =~ s/\s/_/g;
97 8         16 $self->metrics->{$metric} = $self->METRIC_NAMES->{$metric}->{names}->{$name};
98 8         157 return $self;
99             }
100              
101             sub _metric_value_to_name {
102 8     8   16 my ($self, $metric) = @_;
103 8         20 $self->METRIC_NAMES->{$metric}->{values}->{$self->metrics->{$metric}};
104             }
105              
106 5501 50   5501 1 30603 sub version { shift->{version} || Carp::croak 'Missing CVSS version' }
107 1 50   1 1 4 sub vector_string { $_[0]->{vector_string} || $_[0]->to_vector_string }
108 363352     363352 1 711138 sub metrics { shift->{metrics} }
109 0     0 1 0 sub scores { shift->{scores} }
110              
111              
112             # Scores & severities
113 4259     4259 1 22825 sub base_score { shift->{scores}->{base} }
114 2     2 1 5 sub base_severity { $_[0]->score_to_severity($_[0]->base_score) }
115              
116             # CVSS 2.0/3.x scores & severities
117 2     2 1 4 sub temporal_score { shift->{scores}->{temporal} }
118 1     1 1 3 sub temporal_severity { $_[0]->score_to_severity($_[0]->temporal_score) }
119 2     2 1 4 sub environmental_score { shift->{scores}->{environmental} }
120 1     1 1 3 sub environmental_severity { $_[0]->score_to_severity($_[0]->environmental_score) }
121              
122             # Extra 2.0/3.x scores
123 0     0 1 0 sub exploitability_score { shift->{scores}->{exploitability} }
124 0     0 1 0 sub impact_score { shift->{scores}->{impact} }
125 0     0 1 0 sub modified_impact_score { shift->{scores}->{modified_impact} }
126              
127              
128             # JSON-style alias
129 0     0 0 0 sub vectorString { shift->vector_string }
130 0     0 0 0 sub baseScore { shift->base_score }
131 0     0 0 0 sub baseSeverity { shift->base_severity }
132 0     0 0 0 sub temporalScore { shift->temporal_score }
133 0     0 0 0 sub temporalSeverity { shift->temporal_severity }
134 0     0 0 0 sub environmentalScore { shift->environmental_score }
135 0     0 0 0 sub environmentalSeverity { shift->environmental_severity }
136              
137              
138             sub metric_group_is_set {
139              
140 4038     4038 1 5434 my ($self, $type) = @_;
141              
142 4038         3529 for (@{$self->METRIC_GROUPS->{$type}}) {
  4038         5801  
143 26794 50 33     28040 return 1 if ($self->M($_) && $self->M($_) ne $self->NOT_DEFINED_VALUE);
144             }
145              
146             }
147              
148             sub metric {
149 0     0 1 0 my ($self, $metric) = @_;
150 0         0 my $value = $self->M($metric);
151              
152 0         0 return $self->METRIC_NAMES->{$metric}->{values}->{$value};
153             }
154              
155 243988     243988 1 255475 sub M { $_[0]->metrics->{$_[1]} }
156              
157             sub score_to_severity {
158              
159 4     4 1 5 my ($self, $score) = @_;
160              
161 4 100       17 return unless (!!$score);
162              
163 2         6 my $SCORE_SEVERITY = $self->SCORE_SEVERITY;
164              
165 2         4 foreach (keys %{$SCORE_SEVERITY}) {
  2         7  
166 2         2 my $range = $SCORE_SEVERITY->{$_};
167 2 50 33     14 if ($score >= $range->{min} && $score <= $range->{max}) {
168 2         9 return $_;
169             }
170             }
171              
172 0         0 Carp::croak 'Unknown severity';
173              
174             }
175              
176 0     0 1 0 sub calculate_score { Carp::croak sprintf('%s->calculate_score() is not implemented in subclass', ref(shift)) }
177              
178 0     0 1 0 sub to_xml { Carp::croak sprintf('%s->to_xml() is not implemented in subclass', ref(shift)) }
179              
180 0     0 0 0 sub to_string { shift->to_vector_string }
181              
182             sub to_vector_string {
183              
184 4253     4253 1 7659 my ($self) = @_;
185              
186 4253         9487 my $metrics = $self->metrics;
187 4253         5918 my @vectors = ();
188              
189 4253 100       10726 if ($self->version > 2.0) {
190 3885         7201 push @vectors, sprintf('CVSS:%s', $self->version);
191             }
192              
193 4253         6385 foreach my $metric (@{$self->METRIC_GROUPS->{base}}) {
  4253         10466  
194 39450 50       66193 return if (!$metrics->{$metric});
195 39450         63567 push @vectors, sprintf('%s:%s', $metric, $metrics->{$metric});
196             }
197              
198 4253         5338 my @other_metrics = ();
199              
200 4253 100       5300 push @other_metrics, @{$self->METRIC_GROUPS->{threat} || []}; # CVSS 4.0
  4253         7435  
201 4253 100       5781 push @other_metrics, @{$self->METRIC_GROUPS->{temporal} || []}; # CVSS 2.0-3.x
  4253         6770  
202 4253 50       5651 push @other_metrics, @{$self->METRIC_GROUPS->{environmental} || []}; # CVSS 2.0-3.x-4.0
  4253         6230  
203 4253 100       5193 push @other_metrics, @{$self->METRIC_GROUPS->{supplemental} || []}; # CVSS 4.0
  4253         6774  
204              
205 4253         5984 foreach my $metric (@other_metrics) {
206 71712 50 66     150919 if (defined $metrics->{$metric} && $metrics->{$metric} ne $self->NOT_DEFINED_VALUE) {
207 0         0 push @vectors, sprintf('%s:%s', $metric, $metrics->{$metric});
208             }
209             }
210              
211 4253         27912 return join '/', @vectors;
212              
213             }
214              
215             sub TO_JSON {
216              
217 1     1 1 174 my ($self) = @_;
218              
219             # Required JSON fields:
220             # CVSS == v2.0: version, vectorString and baseScore
221             # CVSS >= v3.0: version, vectorString, baseScore and baseSeverity
222              
223 1 50       25 $self->calculate_score unless ($self->base_score);
224              
225 1         2 my $json = {
226             version => sprintf('%.1f', $self->version),
227             vectorString => $self->vector_string,
228             baseScore => $self->base_score
229             };
230              
231 1 50       2 if ($self->version > 2.0) {
232 1         4 $json->{baseSeverity} = $self->base_severity;
233             }
234              
235 1         3 my $metrics = $self->metrics;
236 1         2 my %attributes = reverse(%{$self->ATTRIBUTES});
  1         3  
237              
238 1         2 foreach my $metric (@{$self->METRIC_GROUPS->{base}}) {
  1         2  
239 8         17 $json->{$attributes{$metric}} = $self->METRIC_NAMES->{$metric}->{values}->{$metrics->{$metric}};
240             }
241              
242 1         2 my @other_metrics = ();
243              
244 1 50       2 push @other_metrics, @{$self->METRIC_GROUPS->{threat} || []}; # CVSS 4.0
  1         2  
245 1 50       2 push @other_metrics, @{$self->METRIC_GROUPS->{temporal} || []}; # CVSS 2.0-3.x
  1         2  
246 1 50       1 push @other_metrics, @{$self->METRIC_GROUPS->{environmental} || []}; # CVSS 2.0-3.x-4.0
  1         3  
247 1 50       2 push @other_metrics, @{$self->METRIC_GROUPS->{supplemental} || []}; # CVSS 4.0
  1         2  
248              
249 1         2 foreach my $metric (@other_metrics) {
250 14 50 33     39 if ($metrics->{$metric} && $metrics->{$metric} ne $self->NOT_DEFINED_VALUE) {
251 0         0 $json->{$attributes{$metric}} = $self->METRIC_NAMES->{$metric}->{values}->{$metrics->{$metric}};
252             }
253             }
254              
255 1 50       3 if ($self->version <= 3.1) {
256              
257 1 50       3 if ($self->metric_group_is_set('temporal')) {
258              
259 0         0 $json->{temporalScore} = $self->temporal_score;
260              
261 0 0       0 if ($self->version != 2.0) {
262 0         0 $json->{temporalSeverity} = $self->temporal_severity;
263             }
264              
265             }
266              
267 1 50       3 if ($self->metric_group_is_set('environmental')) {
268              
269 0         0 $json->{environmentalScore} = $self->environmental_score;
270              
271 0 0       0 if ($self->version != 2.0) {
272 0         0 $json->{environmentalSeverity} = $self->environmental_severity;
273             }
274              
275             }
276              
277             }
278              
279             # CVSS 4.0 ???
280              
281             # environmentalScore
282             # environmentalSeverity
283             # threatScore
284             # threatSeverity
285              
286 1         5 return $json;
287              
288             }
289              
290             1;
291             __END__