File Coverage

blib/lib/Metabrik/Database/Cwe.pm
Criterion Covered Total %
statement 9 93 9.6
branch 0 40 0.0
condition 0 19 0.0
subroutine 3 9 33.3
pod 1 5 20.0
total 13 166 7.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # database::cwe Brik
5             #
6             package Metabrik::Database::Cwe;
7 1     1   548 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         28  
9              
10 1     1   5 use base qw(Metabrik::Client::Www);
  1         1  
  1         476  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable cve) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             file => [ qw(file) ],
21             xml => [ qw($xml_data) ],
22             },
23             attributes_default => {
24             file => '2000.xml',
25             },
26             commands => {
27             update => [ ],
28             load => [ qw(cwe_xml_file) ],
29             search => [ qw(cwe_pattern) ],
30             },
31             require_modules => {
32             'Metabrik::File::Compress' => [ ],
33             'Metabrik::File::Xml' => [ ],
34             },
35             };
36             }
37              
38             sub update {
39 0     0 0   my $self = shift;
40              
41 0           my $datadir = $self->datadir;
42              
43 0           my $uri = 'http://cwe.mitre.org/data/xml/views/2000.xml.zip';
44 0           my $file_zip = "2000.xml.zip";
45              
46 0           my @updated = ();
47 0 0         my $files = $self->mirror($uri, $file_zip) or return;
48 0 0         if (@$files > 0) { # Some new stuff
49 0 0         my $fc = Metabrik::File::Compress->new_from_brik_init($self) or return;
50 0           for my $file (@$files) {
51 0           (my $outfile = $file) =~ s/\.zip$//;
52 0 0         my $new_files = $fc->uncompress($file, $outfile, $datadir) or next;
53 0           push @updated, @$new_files;
54             }
55             }
56              
57 0           return \@updated;
58             }
59              
60             sub load {
61 0     0 0   my $self = shift;
62 0           my ($file) = @_;
63              
64 0   0       $file ||= $self->file;
65 0 0         $self->brik_help_run_undef_arg('load', $file) or return;
66 0 0         $self->brik_help_run_file_not_found('load', $file) or return;
67              
68 0           my $datadir = $self->datadir;
69              
70 0 0         my $fx = Metabrik::File::Xml->new_from_brik_init($self) or return;
71              
72 0 0         my $xml = $fx->read($datadir.'/'.$file) or return;
73              
74 0           return $self->xml($xml);
75             }
76              
77             sub show {
78 0     0 0   my $self = shift;
79 0           my ($h) = @_;
80              
81 0 0         $self->brik_help_run_undef_arg('show', $h) or return;
82 0 0         $self->brik_help_run_invalid_arg('show', $h, 'HASH') or return;
83              
84 0           my $buf = "ID: ".$h->{id}."\n";
85 0           $buf .= "Type: ".$h->{type}."\n";
86 0           $buf .= "Name: ".$h->{name}."\n";
87 0           $buf .= "Status: ".$h->{status}."\n";
88 0           $buf .= "URL: ".$h->{url}."\n";
89 0   0       $buf .= "Description Summary: ".($h->{description_summary} || '(undef)')."\n";
90 0   0       $buf .= "Likelihood of Exploit: ".($h->{likelihood_of_exploit} || '(undef)')."\n";
91 0           $buf .= "Relationships:\n";
92 0           for my $r (@{$h->{relationships}}) {
  0            
93             $buf .= " ".$r->{relationship_nature}." ".$r->{relationship_target_form}." ".
94 0           $r->{relationship_target_id}."\n";
95             }
96              
97 0           return $buf;
98             }
99              
100             sub _to_hash {
101 0     0     my $self = shift;
102 0           my ($w, $type) = @_;
103              
104 0           my $id = $w->{ID};
105 0           my $name = $w->{Name};
106 0           my $status = $w->{Status};
107 0           my $likelihood_of_exploit = $w->{Likelihood_of_Exploit};
108 0           my $weakness_abstraction = $w->{Weakness_Abstraction};
109 0           my $description_summary = $w->{Description}->{Description_Summary};
110 0 0         if (defined($description_summary)) {
111 0           $description_summary =~ s/\s*\n\s*/ /gs;
112             }
113 0           my $extended_description = $w->{Description}->{Extended_Description}->{Text};
114 0 0         if (defined($extended_description)) {
115 0           $extended_description =~ s/\s*\n\s*/ /gs;
116             }
117 0           my $relationships = $w->{Relationships}->{Relationship};
118             # Potential_Mitigations
119             # Affected_Resources
120              
121 0           my @relationships = ();
122 0 0         if (defined($relationships)) {
123             #print "DEBUG Processing ID [$id]\n";
124             #print "DEBUG ".ref($relationships)."\n";
125             # $relationships can be ARRAY or HASH, we convert to ARRAY
126 0 0         if (ref($relationships) eq 'HASH') {
127 0           $relationships = [ $relationships ];
128             }
129 0           for my $r (@$relationships) {
130 0           my $relationship_nature = $r->{Relationship_Nature};
131 0           my $relationship_target_id = $r->{Relationship_Target_ID};
132 0           my $relationship_target_form = $r->{Relationship_Target_Form};
133 0           push @relationships, {
134             relationship_nature => $relationship_nature,
135             relationship_target_id => $relationship_target_id,
136             relationship_target_form => $relationship_target_form,
137             };
138             }
139             }
140              
141             return {
142 0           id => $id,
143             type => $type,
144             name => $name,
145             status => $status,
146             url => 'http://cwe.mitre.org/data/definitions/'.$id.'.html',
147             likelihood_of_exploit => $likelihood_of_exploit,
148             description_summary => $description_summary,
149             relationships => \@relationships,
150             };
151             }
152              
153             sub search {
154 0     0 0   my $self = shift;
155 0           my ($pattern) = @_;
156              
157 0           my $xml = $self->xml;
158 0 0         $self->brik_help_run_undef_arg('load', $xml) or return;
159 0 0         $self->brik_help_run_undef_arg('search', $pattern) or return;
160              
161 0           my @list = ();
162 0 0 0       if (exists $xml->{Weaknesses} && exists $xml->{Weaknesses}->{Weakness}) {
163 0           my $weaknesses = $xml->{Weaknesses}->{Weakness};
164 0           for my $w (@$weaknesses) {
165 0           my $this = $self->_to_hash($w, 'Weakness');
166 0 0 0       if ($this->{name} =~ /$pattern/i || $this->{id} =~ /^$pattern$/) {
167 0           print $self->show($this)."\n";
168 0           push @list, $this;
169             }
170             }
171             }
172              
173 0 0 0       if (exists $xml->{Categories} && exists $xml->{Categories}->{Category}) {
174 0           my $categories = $xml->{Categories}->{Category};
175 0           for my $c (@$categories) {
176 0           my $this = $self->_to_hash($c, 'Category');
177 0 0 0       if ($this->{name} =~ /$pattern/i || $this->{id} =~ /^$pattern$/) {
178 0           print $self->show($this)."\n";
179 0           push @list, $this;
180             }
181             }
182             }
183              
184             # XXX: TODO: type: Compound_Element
185              
186 0           return \@list;
187             }
188              
189             1;
190              
191             __END__