Skip to content

Commit 8f7e027

Browse files
kraihkraih
committed
Add basic support for detecting known incompatible licenses
1 parent 4431d1d commit 8f7e027

File tree

6 files changed

+366
-6
lines changed

6 files changed

+366
-6
lines changed

‎lib/Cavil/Model/Reports.pm‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ use Mojo::JSON qw(from_json to_json);
2222
use Spooky::Patterns::XS;
2323
use Cavil::Checkout;
2424
use Cavil::Licenses qw(lic);
25-
use Cavil::ReportUtil qw(estimated_risk);
25+
use Cavil::ReportUtil qw(estimated_risk incompatible_licenses);
2626

2727
has [qw(acceptable_packages acceptable_risk checkout_dir max_expanded_files pg)];
2828

@@ -45,6 +45,9 @@ sub dig_report {
4545

4646
my $report = $self->_dig_report($db, {}, $pkg, \%ignored_lines, $limit_to_file);
4747

48+
# Incompatible licenses
49+
$report->{incompatible_licenses} = incompatible_licenses($report);
50+
4851
# prune match caches
4952
delete $report->{matches};
5053
return $report;
@@ -171,6 +174,8 @@ sub summary ($self, $id) {
171174
}
172175
$summary{missed_snippets} = $files;
173176

177+
$summary{incompatible_licenses} = $report->{incompatible_licenses};
178+
174179
return \%summary;
175180
}
176181

‎lib/Cavil/ReportUtil.pm‎

Lines changed: 68 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,17 +18,53 @@ package Cavil::ReportUtil;
1818
use Mojo::Base -strict, -signatures;
1919

2020
use Exporter 'import';
21-
use List::Util 'uniq';
21+
use List::Util qw(uniq);
2222
use Mojo::Util;
2323
use Cavil::Licenses 'lic';
2424

25-
our @EXPORT_OK = (qw(estimated_risk report_checksum report_shortname summary_delta summary_delta_score));
25+
our @EXPORT_OK
26+
= (qw(estimated_risk incompatible_licenses report_checksum report_shortname summary_delta summary_delta_score));
27+
28+
# For now we only watch out for GPL-2.0-only and Apache-2.0
29+
my $INCOMPATIBLE_LICENSE_RULES = [{licenses => ['GPL-2.0-only', 'Apache-2.0']}];
2630

2731
sub estimated_risk ($risk, $match) {
2832
my $estimated = int(($risk * $match + 9 * (1 - $match)) + 0.5);
2933
return $match < 0.9 && $estimated <= 3 ? 4 : $estimated;
3034
}
3135

36+
sub incompatible_licenses ($dig_report, $rules = $INCOMPATIBLE_LICENSE_RULES) {
37+
return [] unless @$rules && (my $licenses = $dig_report->{licenses});
38+
39+
my @spdx = map { $_->{spdx} } grep { $_->{spdx} } values %$licenses;
40+
41+
my @regexes;
42+
for my $rule (@$rules) {
43+
push @regexes, [qr/\Q$_\E/i, $_] for @{$rule->{licenses}};
44+
}
45+
46+
my %matches;
47+
for my $spdx (@spdx) {
48+
for my $pair (@regexes) {
49+
next unless $spdx =~ $pair->[0];
50+
$matches{$pair->[1]}++;
51+
}
52+
}
53+
54+
my @results;
55+
for my $rule (@$rules) {
56+
my $licenses = $rule->{licenses};
57+
my $found = 0;
58+
for my $license (@$licenses) {
59+
last unless $matches{$license};
60+
$found++;
61+
}
62+
push @results, {licenses => [@$licenses]} if $found == @$licenses;
63+
}
64+
65+
return \@results;
66+
}
67+
3268
sub report_checksum ($specfile_report, $dig_report) {
3369

3470
# Specfile license
@@ -56,6 +92,13 @@ sub report_checksum ($specfile_report, $dig_report) {
5692
$text .= "SNIPPET:$_\n" for uniq @all;
5793
}
5894

95+
# License incompatibilities
96+
if (my $incompat = $dig_report->{incompatible_licenses}) {
97+
for my $rule (@$incompat) {
98+
$text .= "INCOMPAT:" . join(':', sort @{$rule->{licenses}}) . "\n";
99+
}
100+
}
101+
59102
return Mojo::Util::md5_sum $text;
60103
}
61104

@@ -68,6 +111,7 @@ sub report_shortname ($chksum, $specfile_report, $dig_report) {
68111
my $risk = $dig_report->{missed_files}{$file}[0];
69112
$max_risk = $risk if $risk > $max_risk;
70113
}
114+
$max_risk = 9 if $dig_report->{incompatible_licenses} && @{$dig_report->{incompatible_licenses}};
71115

72116
my $l = lic($specfile_report->{main}{license})->example;
73117
$l ||= 'Unknown';
@@ -114,6 +158,12 @@ sub summary_delta ($old, $new) {
114158
$text .= join("\n", @lines) . "\n\n";
115159
}
116160

161+
# License incompatibilities
162+
if (my @licenses = _new_incompatibilities($old, $new)) {
163+
my $licenses = join(', ', @licenses);
164+
$text .= " Found new possible license incompatibility involving: $licenses\n\n";
165+
}
166+
117167
return length $text ? "Diff to closest match $old->{id}:\n\n$text" : '';
118168
}
119169

@@ -126,6 +176,9 @@ sub summary_delta_score ($old, $new) {
126176

127177
my $score = 0;
128178

179+
# License incompatibilities
180+
$score += 500 for _new_incompatibilities($old, $new);
181+
129182
# New files with missed snippets (count)
130183
if (keys %{$new->{missed_snippets}} > keys %{$old->{missed_snippets}}) {
131184
$score += 250;
@@ -159,4 +212,17 @@ sub summary_delta_score ($old, $new) {
159212
return $score;
160213
}
161214

215+
sub _new_incompatibilities ($old, $new) {
216+
my @old_incompat = map { @{$_->{licenses}} } @{$old->{incompatible_licenses} || []};
217+
my @new_incompat = uniq(map { @{$_->{licenses}} } @{$new->{incompatible_licenses} || []});
218+
my %old = map { $_ => 1 } @old_incompat;
219+
220+
my @new;
221+
for my $lic (@new_incompat) {
222+
push @new, $lic unless $old{$lic};
223+
}
224+
225+
return @new;
226+
}
227+
162228
1;

‎t/incompatible_licenses.t‎

Lines changed: 102 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,102 @@
1+
# Copyright (C) 2025 SUSE LLC
2+
#
3+
# This program is free software; you can redistribute it and/or modify
4+
# it under the terms of the GNU General Public License as published by
5+
# the Free Software Foundation; either version 2 of the License, or
6+
# (at your option) any later version.
7+
#
8+
# This program is distributed in the hope that it will be useful,
9+
# but WITHOUT ANY WARRANTY; without even the implied warranty of
10+
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11+
# GNU General Public License for more details.
12+
#
13+
# You should have received a copy of the GNU General Public License along
14+
# with this program; if not, see <http://www.gnu.org/licenses/>.
15+
16+
use Mojo::Base -strict;
17+
18+
use FindBin;
19+
use lib "$FindBin::Bin/lib";
20+
21+
use Test::More;
22+
use Test::Mojo;
23+
use Cavil::Test;
24+
use Mojo::File qw(path);
25+
26+
plan skip_all => 'set TEST_ONLINE to enable this test' unless $ENV{TEST_ONLINE};
27+
28+
my $cavil_test = Cavil::Test->new(online => $ENV{TEST_ONLINE}, schema => 'incompatible_licenses_test');
29+
my $t = Test::Mojo->new(Cavil => $cavil_test->default_config);
30+
$cavil_test->mojo_fixtures($t->app);
31+
32+
# Add patterns for known incompatible licenses
33+
$t->app->pg->db->query('DELETE FROM license_patterns');
34+
$t->app->patterns->create(pattern => 'SPDX-License-Identifier: Apache-2.0', license => 'Apache-2.0');
35+
$t->app->patterns->create(pattern => 'SPDX-License-Identifier: GPL-2.0-only', license => 'GPL-2.0-only');
36+
$t->app->pg->db->query('UPDATE license_patterns SET spdx = $1 WHERE license = $1', $_) for qw(Apache-2.0 GPL-2.0-only);
37+
38+
# Add files with incompatible licenses
39+
my $pkg = $t->app->packages->find(1);
40+
my $dir = path($cavil_test->checkout_dir, $pkg->{name}, $pkg->{checkout_dir});
41+
$dir->child('apache_file.txt')->spurt("# SPDX-License-Identifier: Apache-2.0\n\nThis is a test file.\n");
42+
$dir->child('gpl2_file.txt')->spurt("# SPDX-License-Identifier: GPL-2.0-only\n\nThis is another test file.\n");
43+
44+
# Unpack and index
45+
$t->app->minion->enqueue(unpack => [1]);
46+
$t->app->minion->perform_jobs;
47+
48+
subtest 'GPL-2.0-only and Apache-2.0 detected as incompatible' => sub {
49+
$t->get_ok('/login')->status_is(302)->header_is(Location => '/');
50+
51+
subtest 'Details after indexing' => sub {
52+
$t->get_ok('/reviews/meta/1')
53+
->status_is(200)
54+
->json_like('/package_license/name', qr!Artistic-2.0!)
55+
->json_is('/package_license/spdx', 1)
56+
->json_like('/package_version', qr!7\.25!)
57+
->json_like('/package_summary', qr!Real-time web framework!)
58+
->json_like('/package_group', qr!Development/Libraries/Perl!)
59+
->json_like('/package_url', qr!http://search\.cpan\.org/dist/Mojolicious/!)
60+
->json_like('/state', qr!new!)
61+
->json_is('/unpacked_files', 341)
62+
->json_is('/unpacked_size', '2.5MiB');
63+
64+
$t->json_like('/package_files/0/file', qr/perl-Mojolicious\.spec/)
65+
->json_like('/package_files/0/licenses/0', qr/Artistic-2.0/)
66+
->json_like('/package_files/0/version', qr/7\.25/)
67+
->json_like('/package_files/0/sources/0', qr/http:\/\/www\.cpan\.org/)
68+
->json_like('/package_files/0/summary', qr/Real-time web framework/)
69+
->json_like('/package_files/0/url', qr/http:\/\//)
70+
->json_like('/package_files/0/group', qr/Development\/Libraries\/Perl/);
71+
72+
$t->json_is('/errors', [])->json_is('/warnings', []);
73+
};
74+
75+
subtest 'JSON report' => sub {
76+
$t->get_ok('/reviews/report/1.json')->status_is(200);
77+
ok my $json = $t->tx->res->json, 'JSON response';
78+
79+
ok my $pkg = $json->{package}, 'package';
80+
is $pkg->{id}, 1, 'id';
81+
is $pkg->{name}, 'perl-Mojolicious', 'name';
82+
like $pkg->{checksum}, qr!Artistic-2.0-9!, 'checksum with elevated risk because of incompatible licenses';
83+
is $pkg->{state}, 'new', 'state';
84+
is $pkg->{notice}, 'Manual review is required because no previous reports are available', 'requires manual review';
85+
86+
ok my $report = $json->{report}, 'report';
87+
is_deeply $report->{incompatible_licenses}, [{licenses => ['GPL-2.0-only', 'Apache-2.0']}], 'incompatible licenses';
88+
89+
};
90+
91+
subtest 'Text report' => sub {
92+
$t->get_ok('/reviews/report/1.txt')->status_is(200);
93+
ok my $text = $t->tx->res->text, 'text response';
94+
like $text, qr/Elevated risk, package might contain incompatible licenses:/,
95+
'text report contains warning about incompatible licenses';
96+
like $text, qr/GPL-2.0-only, Apache-2.0/, 'text report lists incompatible licenses';
97+
};
98+
99+
$t->get_ok('/logout')->status_is(302)->header_is(Location => '/');
100+
};
101+
102+
done_testing;

0 commit comments

Comments
 (0)