line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# $Id: DB.pm 12 2014-04-10 12:00:59Z gomor $ |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
package vFeed::DB; |
5
|
1
|
|
|
1
|
|
901
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
41
|
|
6
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
64
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
5
|
use base qw(Class::Gomor::Array); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
256
|
|
9
|
|
|
|
|
|
|
our @AS = qw( |
10
|
|
|
|
|
|
|
file |
11
|
|
|
|
|
|
|
log |
12
|
|
|
|
|
|
|
_dbh |
13
|
|
|
|
|
|
|
_prepared |
14
|
|
|
|
|
|
|
); |
15
|
|
|
|
|
|
|
__PACKAGE__->cgBuildIndices; |
16
|
|
|
|
|
|
|
__PACKAGE__->cgBuildAccessorsScalar(\@AS); |
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
7
|
use vFeed; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
24
|
|
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
1
|
|
37554
|
use DBI; |
|
1
|
|
|
|
|
20961
|
|
|
1
|
|
|
|
|
91
|
|
21
|
1
|
|
|
1
|
|
12
|
use Data::Dumper; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
22
|
|
|
|
|
|
|
|
23
|
1
|
|
|
1
|
|
1507
|
use FindBin qw($Bin); |
|
1
|
|
|
|
|
7805
|
|
|
1
|
|
|
|
|
160
|
|
24
|
1
|
|
|
1
|
|
1379
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
77925
|
|
|
1
|
|
|
|
|
42
|
|
25
|
1
|
|
|
1
|
|
1241
|
use Digest::SHA1; |
|
1
|
|
|
|
|
1005
|
|
|
1
|
|
|
|
|
59
|
|
26
|
1
|
|
|
1
|
|
1274
|
use Archive::Tar; |
|
1
|
|
|
|
|
265006
|
|
|
1
|
|
|
|
|
1734
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub new { |
29
|
0
|
|
|
0
|
1
|
|
my $self = shift->SUPER::new( |
30
|
|
|
|
|
|
|
_dbh => 0, |
31
|
|
|
|
|
|
|
@_, |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
0
|
0
|
|
|
|
|
if (!defined($self->log)) { |
35
|
0
|
|
|
|
|
|
die("[-] ".__PACKAGE__.": You must provide a log object\n"); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
0
|
|
|
|
|
|
return $self; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub init { |
42
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
43
|
|
|
|
|
|
|
|
44
|
0
|
|
|
|
|
|
my $log = $self->log; |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
my $file = $self->file; |
47
|
0
|
0
|
|
|
|
|
if (!defined($file)) { |
48
|
0
|
|
|
|
|
|
for ("$Bin/", "$Bin/../db/") { |
49
|
0
|
0
|
|
|
|
|
if (-f $_.'vfeed.db') { |
50
|
0
|
|
|
|
|
|
$file = $_.'vfeed.db'; |
51
|
0
|
|
|
|
|
|
last; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
0
|
0
|
|
|
|
|
if (!defined($file)) { |
|
|
0
|
|
|
|
|
|
57
|
0
|
|
|
|
|
|
$log->fatal("No database file found"); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
elsif (!-f $file) { |
60
|
0
|
|
|
|
|
|
$log->fatal("Database file not found [$file]: $!"); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
$self->file($file); |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
$log->verbose("Using database file: ".$self->file); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $dbh = DBI->connect( |
68
|
|
|
|
|
|
|
"dbi:SQLite:dbname=".$self->file, '', '', { |
69
|
|
|
|
|
|
|
RaiseError => 0, |
70
|
|
|
|
|
|
|
PrintError => 0, |
71
|
|
|
|
|
|
|
AutoCommit => 0, |
72
|
|
|
|
|
|
|
InactiveDestroy => 1, |
73
|
|
|
|
|
|
|
HandleError => sub { |
74
|
0
|
|
|
0
|
|
|
my ($errstr, $dbh, $arg) = @_; |
75
|
|
|
|
|
|
|
# Let's keep fatal() for all errors as a debugging mechanism for now |
76
|
0
|
|
|
|
|
|
$log->fatal("Database error: [$errstr]"); |
77
|
0
|
|
|
|
|
|
return 1; |
78
|
|
|
|
|
|
|
}, |
79
|
0
|
0
|
|
|
|
|
}) or $log->fatal("Database error: [".$DBI::errstr."]"); |
80
|
0
|
|
|
|
|
|
$self->_dbh($dbh); |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
my $p = $dbh->prepare(qq{SELECT count(*) from stat_vfeed_kpi}); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# We fail if stat_vfeed_kpi is empty |
85
|
|
|
|
|
|
|
# The problem may be solved by using the latest DBD::SQLite module |
86
|
0
|
|
|
|
|
|
my $rv = $p->execute; |
87
|
0
|
|
|
|
|
|
my $h = $p->fetchrow_hashref; |
88
|
0
|
|
|
|
|
|
my ($k, $v) = each(%$h); |
89
|
0
|
0
|
|
|
|
|
if (! ($v > 0)) { |
90
|
0
|
|
|
|
|
|
$log->fatal("Unable to find valid vFeed tables"); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Create prepared statements |
94
|
0
|
|
|
|
|
|
$self->_prepare; |
95
|
|
|
|
|
|
|
|
96
|
0
|
|
|
|
|
|
return 1; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub _prepare { |
100
|
0
|
|
|
0
|
|
|
my $self = shift; |
101
|
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
|
my $dbh = $self->_dbh; |
103
|
|
|
|
|
|
|
|
104
|
0
|
|
|
|
|
|
my %select = ( |
105
|
|
|
|
|
|
|
db_version => qq{SELECT db_version FROM stat_vfeed_kpi}, |
106
|
|
|
|
|
|
|
total_cve => qq{SELECT total_cve FROM stat_vfeed_kpi}, |
107
|
|
|
|
|
|
|
latest_cve => qq{SELECT * FROM stat_new_cve}, |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# Information |
110
|
|
|
|
|
|
|
get_cve => qq{SELECT * FROM nvd_db WHERE cveid=?}, |
111
|
|
|
|
|
|
|
get_cpe => qq{SELECT * FROM cve_cpe WHERE cveid=?}, |
112
|
|
|
|
|
|
|
get_cwe => qq{SELECT * FROM cve_cwe WHERE cveid=?}, |
113
|
|
|
|
|
|
|
get_capec => qq{SELECT * FROM cwe_capec WHERE cweid=?}, |
114
|
|
|
|
|
|
|
get_category => qq{SELECT * FROM cwe_category WHERE cweid=?}, |
115
|
|
|
|
|
|
|
get_iavm => qq{SELECT * FROM map_cve_iavm WHERE cveid=?}, |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# References |
118
|
|
|
|
|
|
|
get_refs => qq{SELECT * FROM cve_reference WHERE cveid=?}, |
119
|
|
|
|
|
|
|
get_scip => qq{SELECT * FROM map_cve_scip WHERE cveid=?}, |
120
|
|
|
|
|
|
|
get_osvdb => qq{SELECT * FROM map_cve_osvdb WHERE cveid=?}, |
121
|
|
|
|
|
|
|
get_certvn => qq{SELECT * FROM map_cve_certvn WHERE cveid=?}, |
122
|
|
|
|
|
|
|
get_bid => qq{SELECT * FROM map_cve_bid WHERE cveid=?}, |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Perl version only |
125
|
|
|
|
|
|
|
get_cve_from_cpe => qq{SELECT * FROM cve_cpe WHERE cpeid=?}, |
126
|
|
|
|
|
|
|
); |
127
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
my %prepared = (); |
129
|
0
|
|
|
|
|
|
for my $this (keys %select) { |
130
|
0
|
|
|
|
|
|
my $select = $dbh->prepare($select{$this}); |
131
|
0
|
|
|
|
|
|
$prepared{$this} = $select; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
$self->_prepared(\%prepared); |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
return 1; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub run { |
140
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
141
|
0
|
|
|
|
|
|
return $self; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub db_version { |
145
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
my $log = $self->log; |
148
|
|
|
|
|
|
|
|
149
|
0
|
|
|
|
|
|
my $dbh = $self->_dbh; |
150
|
0
|
|
|
|
|
|
my $s = $self->_prepared->{db_version}; |
151
|
0
|
|
|
|
|
|
my $rv = $s->execute; |
152
|
0
|
|
|
|
|
|
my $h = $s->fetchall_arrayref; |
153
|
|
|
|
|
|
|
|
154
|
0
|
0
|
0
|
|
|
|
if (defined($h->[0]) && defined($h->[0][0])) { |
155
|
0
|
|
|
|
|
|
my $version = $h->[0][0]; |
156
|
0
|
|
|
|
|
|
$version = sprintf("%08d", $version); |
157
|
0
|
|
|
|
|
|
return $version; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
|
$log->fatal("db_version not found"); |
161
|
0
|
|
|
|
|
|
return; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub latest_cve { |
165
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
166
|
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
|
my $dbh = $self->_dbh; |
168
|
0
|
|
|
|
|
|
my $s = $self->_prepared->{latest_cve}; |
169
|
0
|
|
|
|
|
|
my $rv = $s->execute; |
170
|
0
|
|
|
|
|
|
my $h = $s->fetchall_hashref('new_cve_id'); |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
return $h; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub _get_info { |
176
|
0
|
|
|
0
|
|
|
my $self = shift; |
177
|
0
|
|
|
|
|
|
my ($info, $cve) = @_; |
178
|
|
|
|
|
|
|
|
179
|
0
|
|
|
|
|
|
my $log = $self->log; |
180
|
|
|
|
|
|
|
|
181
|
0
|
0
|
|
|
|
|
if (!defined($cve)) { |
182
|
0
|
|
|
|
|
|
$log->error("You MUST provide CVE argument"); |
183
|
0
|
|
|
|
|
|
return; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
|
my $dbh = $self->_dbh; |
187
|
0
|
|
|
|
|
|
my $s = $self->_prepared->{$info}; |
188
|
0
|
|
|
|
|
|
my $rv = $s->execute($cve); |
189
|
0
|
|
|
|
|
|
my $h = $s->fetchall_hashref('cveid'); |
190
|
|
|
|
|
|
|
|
191
|
0
|
|
|
|
|
|
return $h; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _get_info_multi { |
195
|
0
|
|
|
0
|
|
|
my $self = shift; |
196
|
0
|
|
|
|
|
|
my ($info, $id, $cve) = @_; |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
my $log = $self->log; |
199
|
|
|
|
|
|
|
|
200
|
0
|
0
|
|
|
|
|
my $h = $self->_get_info($info, $cve) or return; |
201
|
0
|
|
|
|
|
|
my $dbh = $self->_dbh; |
202
|
0
|
|
|
|
|
|
my $s = $self->_prepared->{$info}; |
203
|
0
|
|
|
|
|
|
my $r = {}; |
204
|
0
|
|
|
|
|
|
for my $cve (keys %$h) { |
205
|
0
|
|
|
|
|
|
my $rv = $s->execute($cve); |
206
|
0
|
|
|
|
|
|
my $a = $s->fetchall_hashref($id); |
207
|
0
|
|
|
|
|
|
$r->{$cve} = [ keys %$a ]; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
0
|
|
|
|
|
|
return $r; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub get_cve { |
214
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
215
|
0
|
|
|
|
|
|
return $self->_get_info('get_cve', @_); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub get_cpe { |
219
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
220
|
0
|
|
|
|
|
|
return $self->_get_info_multi('get_cpe', 'cpeid', @_); |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub get_cwe { |
224
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
225
|
0
|
|
|
|
|
|
return $self->_get_info_multi('get_cwe', 'cweid', @_); |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub get_capec { |
229
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
230
|
0
|
|
|
|
|
|
return $self->_get_info_multi('get_capec', 'capecid', @_); |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub get_category { |
234
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
235
|
0
|
|
|
|
|
|
return $self->_get_info('get_category', @_); |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub get_iavm { |
239
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
240
|
0
|
|
|
|
|
|
return $self->_get_info('get_iavm', @_); |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub get_cve_from_cpe { |
244
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
245
|
0
|
|
|
|
|
|
return $self->_get_info('get_cve_from_cpe', @_); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub post { |
249
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
250
|
|
|
|
|
|
|
|
251
|
0
|
0
|
|
|
|
|
if ($self->_dbh) { |
252
|
0
|
|
|
|
|
|
$self->_dbh->disconnect; |
253
|
0
|
|
|
|
|
|
$self->_dbh(undef); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
|
return 1; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub update { |
260
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
my $log = $self->log; |
263
|
|
|
|
|
|
|
|
264
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new; |
265
|
0
|
|
|
|
|
|
$ua->timeout(10); |
266
|
0
|
|
|
|
|
|
$ua->env_proxy; |
267
|
0
|
|
|
|
|
|
$ua->agent("Perl::vFeed ".$vFeed::VERSION); |
268
|
|
|
|
|
|
|
|
269
|
0
|
|
|
|
|
|
my $dbFile = $self->file; |
270
|
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
my $url = "http://www.toolswatch.org/vfeed/update.dat"; |
272
|
0
|
|
|
|
|
|
my $db = $ua->get($url); |
273
|
0
|
0
|
|
|
|
|
if ($db->is_success) { |
274
|
0
|
|
|
|
|
|
(my $sha1 = $db->decoded_content) =~ s/^.*,(.*)$/$1/; |
275
|
0
|
|
|
|
|
|
chomp($sha1); |
276
|
0
|
0
|
|
|
|
|
open(my $in, '<', $dbFile) or $log->fatal( |
277
|
|
|
|
|
|
|
"open1: $dbFile: $!" |
278
|
|
|
|
|
|
|
); |
279
|
0
|
|
|
|
|
|
my $old = Digest::SHA1->new; |
280
|
0
|
|
|
|
|
|
$old->addfile($in); |
281
|
0
|
|
|
|
|
|
my $oldsha1 = $old->hexdigest; |
282
|
0
|
|
|
|
|
|
CORE::close($in); |
283
|
0
|
0
|
|
|
|
|
if ($oldsha1 ne $sha1) { |
284
|
0
|
|
|
|
|
|
$log->info("Database require updating, download in progress..."); |
285
|
0
|
|
|
|
|
|
$self->_updateDb($ua); |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
else { |
288
|
0
|
|
|
|
|
|
$log->info("Database already up-to-date"); |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
else { |
292
|
0
|
|
|
|
|
|
$log->fatal("GET [$url]: ". $db->status_line); |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
return 1; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub _updateDb { |
299
|
0
|
|
|
0
|
|
|
my $self = shift; |
300
|
0
|
|
|
|
|
|
my ($ua) = @_; |
301
|
|
|
|
|
|
|
|
302
|
0
|
|
|
|
|
|
my $log = $self->log; |
303
|
|
|
|
|
|
|
|
304
|
0
|
|
|
|
|
|
my $dbFile = $self->file; |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
my $url = "http://www.toolswatch.org/vfeed/vfeed.db.tgz"; |
307
|
0
|
|
|
|
|
|
my $db = $ua->get($url); |
308
|
0
|
0
|
|
|
|
|
if ($db->is_success) { |
309
|
0
|
|
|
|
|
|
my $tgz = "$dbFile.tgz"; |
310
|
0
|
0
|
|
|
|
|
if (-f $tgz) { |
311
|
0
|
|
|
|
|
|
$log->fatal("$tgz file already exists: we will not overwrite it"); |
312
|
|
|
|
|
|
|
} |
313
|
0
|
0
|
|
|
|
|
open(my $out, '>', $tgz) or $log->fatal( |
314
|
|
|
|
|
|
|
"open2: $dbFile: $!" |
315
|
|
|
|
|
|
|
); |
316
|
0
|
|
|
|
|
|
print $out $db->decoded_content; |
317
|
0
|
|
|
|
|
|
CORE::close($out); |
318
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
|
my $tar = Archive::Tar->new; |
320
|
0
|
|
|
|
|
|
$tar->read($tgz); |
321
|
0
|
|
|
|
|
|
$tar->extract; |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
|
|
|
unlink($tgz); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
else { |
326
|
0
|
|
|
|
|
|
$log->fatal("GET [$url]: ".$db->status_line); |
327
|
|
|
|
|
|
|
} |
328
|
0
|
|
|
|
|
|
$log->info("Update complete for [$dbFile]"); |
329
|
|
|
|
|
|
|
|
330
|
0
|
|
|
|
|
|
return 1; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
1; |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
__END__ |