Merging the work to add the GitHub Advisory stuff

cpansa/CPANSA-Cpanel-JSON-XS.yml

@@ -1,4 +1,10 @@
 ---
+cpansa_version: 2
+distribution: Cpanel-JSON-XS
+last_checked: 1708150840
+latest_version: '4.37'
+metacpan: https://metacpan.org/pod/Cpanel::JSON::XS
+repo: https://github.com/rurban/Cpanel-JSON-XS
 advisories:
 - affected_versions: <3.0225
   cves: []
@@ -40,9 +46,18 @@ advisories:
   - https://github.com/rurban/Cpanel-JSON-XS/commit/41f32396eee9395a40f9ed80145c37622560de9b
   - https://github.com/advisories/GHSA-44qr-8pf6-6q33
   reported: 2023-02-21
-cpansa_version: 2
-distribution: Cpanel-JSON-XS
-last_checked: 1708150840
-latest_version: '4.37'
-metacpan: https://metacpan.org/pod/Cpanel::JSON::XS
-repo: https://github.com/rurban/Cpanel-JSON-XS
+  description: >
+    Wrong error messages/sometimes crashes or endless loops with invalid
+    JSON in relaxed mode
+  references:
+    - https://metacpan.org/changes/distribution/Cpanel-JSON-XS
+    - https://github.com/rurban/Cpanel-JSON-XS/issues/208
+    - https://metacpan.org/release/RURBAN/Cpanel-JSON-XS-4.33/changes
+    - https://nvd.nist.gov/vuln/detail/CVE-2022-48623
+    - https://github.com/rurban/Cpanel-JSON-XS/commit/41f32396eee9395a40f9ed80145c37622560de9b
+    - https://github.com/advisories/GHSA-44qr-8pf6-6q33
+  affected_versions: "<4.033"
+  fixed_versions: ">=4.033"
+  github_advisory_database: https://github.com/advisories/GHSA-44qr-8pf6-6q33
+  cves:
+    - CVE-2022-48623

cpansa/CPANSA-Plack-Middleware-XSRFBlock.yml

@@ -13,6 +13,12 @@ advisories:
   - https://metacpan.org/dist/Plack-Middleware-XSRFBlock/changes
   - https://metacpan.org/release/DAKKAR/Plack-Middleware-XSRFBlock-0.0.19/source/Changes
   - https://nvd.nist.gov/vuln/detail/CVE-2023-52431
+  url: ~
+  id: CPANSA-Plack-Middleware-XSRFBlock-20230714-01
+  references:
+    - https://metacpan.org/dist/Plack-Middleware-XSRFBlock/changes
+    - https://metacpan.org/release/DAKKAR/Plack-Middleware-XSRFBlock-0.0.19/source/Changes
+    - https://nvd.nist.gov/vuln/detail/CVE-2023-52431
   reported: 2023-07-14
   severity: ~
 cpansa_version: 2

util/add-github-advisory

@@ -0,0 +1,175 @@
+#!perl
+use v5.36;
+
+use FindBin qw($Bin);
+use MetaCPAN::Client;
+use Mojo::UserAgent;
+use Mojo::Util qw(dumper);
+use YAML::XS;
+
+my $url = 'https://api.github.com/advisories';
+
+my @files = glob( "external_reports/*.yml" );
+
+$|++;
+
+FILE: foreach my $file ( @files ) {
+	my $data = eval { YAML::XS::LoadFile( $file ) };
+
+	unless( defined $data ) {
+		warn "Could not read $file: $@\n";
+		next FILE;
+		}
+
+	my $advisories = do {
+		if( ref $data eq ref [] ) {
+			$data;
+			}
+		elsif( ref $data eq ref {} ) {
+			$data->{advisories};
+			}
+		else {
+			warn "Did not find advisories in $file. Skipping\n";
+			next FILE;
+			}
+		};
+
+	state $count = 0;
+	my $dist;
+	foreach my $advisory ( $advisories->@* ) {
+		$dist = delete $advisory->{distribution};
+		next if defined $advisory->{github_security_advisory};
+
+		my @cves;
+		push @cves, $advisory->{cves}->@* if exists $advisory->{cves};
+		push @cves, $advisory->{cve} if exists $advisory->{cve};
+
+		my @ghsa_ids;
+		foreach my $cve ( @cves ) {
+			$count++;
+			my $hash = cve_to_ghad($cve);
+			no warnings 'uninitialized';
+			printf "%d\t%s\t%s\t%s\t%s\n", $count, $hash->@{qw(cve ghsa_id type)}, $file;
+			push @ghsa_ids, $hash->{ghsa_id};
+			}
+
+		$advisory->{github_security_advisory} = \@ghsa_ids;
+		};
+
+	$data->{cpansa_version} = 2;
+
+	YAML::XS::DumpFile( $file, $data );
+	}
+
+sub cve_to_ghad ( $cve ) {
+	state $map_file = "$Bin/../data/cve_to_github.tsv";
+
+	state %Seen = do {
+		if( -s -e $map_file ) {
+			if( open my $fh, '<', $map_file ) {
+				my %hash;
+				while( <$fh> ) {
+					next if /\A\s*#/;
+					chomp;
+					my( $cve, $ghsa, $type, $file ) = split /\t/;
+					$hash{$cve}->@{qw(cve ghsa_id type file)} = ($cve, $ghsa, $type, $file);
+					}
+				%hash;
+				}
+			else {
+				warn "Could not open $map_file: $!";
+				();
+				}
+			}
+		else {
+			()
+			}
+		};
+
+	state $ua = do {
+		state $rc = require Mojo::UserAgent;
+		my $ua = Mojo::UserAgent->new;
+		$ua->on( start => sub ( $ua, $tx) {
+			$tx->req->headers->accept('application/vnd.github+json');
+			$tx->req->headers->header('X-GitHub-Api-Version' => '2022-11-28' );
+			$tx->req->headers->authorization("Bearer $ENV{GITHUB_TOKEN}" );
+			} );
+		$ua;
+		};
+	state $sleep_time = 0;
+
+	state $map_fh = do {
+		open my $fh, '>>', $map_file;
+		$fh;
+		};
+
+	state @types = qw(unreviewed reviewed malware);
+
+	return $Seen{$cve} if $Seen{$cve};
+
+	$Seen{$cve}->@{qw(cve ghsa_id type)} = ( $cve, undef, undef );
+
+	TYPE: foreach my $type ( @types ) {
+		my $query = { type => $type, cve_id => $cve };
+		sleep $sleep_time;
+		my $tx = $ua->get( $url => form => $query  );
+		my $code = $tx->res->code;
+		if( $tx->res->code =~ m/\A40[13]\z/ ) {
+			die "Request is unauthorized: check GITHUB_TOKEN value";
+			}
+		elsif( $tx->res->code eq '429' ) {
+			my $reset = $tx->res->headers->header('X-RateLimit-Reset');
+			my $interval = int($reset - time) + 1;
+			warn "Wating for rate limit to reset ($interval seconds)\n";
+			}
+		elsif( $tx->res->code eq '404' ) {
+			next TYPE;
+			}
+
+		$sleep_time = do {
+			my $limit   = $tx->res->headers->header('X-RateLimit-Limit');
+			my $remaining = $tx->res->headers->header('X-RateLimit-Remaining');
+			my $reset = $tx->res->headers->header('X-RateLimit-Reset');
+
+			my $interval = $reset - time;
+			1 + int( $interval /  $remaining );
+			};
+		warn "Sleep time in now $sleep_time\n";
+
+		my $json = eval { $tx->res->json };
+		next TYPE unless eval{ $json->@* > 0 };
+		$Seen{$cve}->@{qw(ghsa_id type)} = ( $tx->res->json->[0]{ghsa_id}, $type );
+		say { $map_fh } join "\t", $Seen{$cve}->@{qw(cve ghsa_id type)};
+		last TYPE;
+		}
+
+	return $Seen{$cve};
+	}
+
+__END__
+cpansa/CPANSA-ActivePerl.yml: ref: ARRAY
+HTTP/1.1 200 OK
+Access-Control-Allow-Origin: *
+Access-Control-Expose-Headers: ETag, Link, Location, Retry-After, X-GitHub-OTP, X-RateLimit-Limit, X-RateLimit-Remaining, X-RateLimit-Used, X-RateLimit-Resource, X-RateLimit-Reset, X-OAuth-Scopes, X-Accepted-OAuth-Scopes, X-Poll-Interval, X-GitHub-Media-Type, X-GitHub-SSO, X-GitHub-Request-Id, Deprecation, Sunset
+Cache-Control: public, max-age=60, s-maxage=60
+Content-Length: 2
+Content-Security-Policy: default-src 'none'
+Content-Type: application/json; charset=utf-8
+Date: Fri, 16 Feb 2024 04:34:34 GMT
+ETag: "74d1db57f0fec3481bb6b4d9bcdc020d656635ec6c53ee589d27a8831cbbe280"
+Referrer-Policy: origin-when-cross-origin, strict-origin-when-cross-origin
+Server: GitHub.com
+Strict-Transport-Security: max-age=31536000; includeSubdomains; preload
+Vary: Accept
+Vary: Accept-Encoding, Accept, X-Requested-With
+X-Content-Type-Options: nosniff
+X-Frame-Options: deny
+x-github-api-version-selected: 2022-11-28
+X-GitHub-Media-Type: github.v3; format=json
+X-GitHub-Request-Id: DF97:29C0:4251485:858FC92:65CEE5D9
+X-RateLimit-Limit: 60
+X-RateLimit-Remaining: 36
+X-RateLimit-Reset: 1708060022
+X-RateLimit-Resource: core
+X-RateLimit-Used: 24
+X-XSS-Protection: 0

util/generate

@@ -19,7 +19,7 @@ use subs qw(config message);
 
 =head1 NAME
 
-util/generate - create the data for lib/CPAN/Audit/DB.pm
+util/generate - create the data for perl-module/lib/CPAN/Audit/DB.pm
 
 =head1 SYNOPSIS
 
@@ -58,7 +58,7 @@ Maintained by: brian d foy (C<[email protected]>)
 
 =head1 LICENSE
 
-L<CPAN::Audit> is dual-licensed under the GPL or the Artistic License.
+L<CPAN::Audit::DB> is dual-licensed under the GPL or the Artistic License.
 See the included F<LICENSE> file for details.
 
 =cut
@@ -120,7 +120,7 @@ sub all_releases {
 }
 
 sub default_file () {
-	state $file = catfile(qw(lib CPAN Audit DB.pm));
+	state $file = catfile(qw(perl-module lib CPAN Audit DB.pm));
 	$file;
 }
 
@@ -144,10 +144,14 @@ sub default_version () {
 sub get_file_list ( $args ) {
 	message "Updating git\n";
 	system 'git', 'pull';
+<<<<<<< HEAD
 	unless( @$args and -e 'cpan-security-advisory/cpansa' ) {
 		debug 'No arguments given fo: looking in cpan-security-advisory/cpansa';
 		@$args = glob( 'cpansa/*.yml' );
 	}
+=======
+	@$args = glob( 'cpansa/*.yml' );
+>>>>>>> c42acb6 (A few more report coversions)
 
 	my @files = ($^O eq 'MSWin32') ? map { glob } @$args : @$args;
 

util/invert-third-party.pl

@@ -3,6 +3,7 @@
 use warnings;
 use experimental qw(signatures);
 
+use MetaCPAN::Client;
 use File::Spec::Functions;
 use IO::Interactive qw(interactive);
 
@@ -159,14 +160,33 @@ ( $advisories )
 	}
 
 sub dump_reports ( $file, $data, $advisories, $perl_dist, $affected ) {
-	my @reports;
+	my %report;
+	$report{generated}{from} = $file;
+	$report{generated}{date} = scalar localtime;
+	$report{generated}{by} = $0;
+	$report{advisories} = [];
+	$report{distribution} = $perl_dist->{name};
+
+	$report{cpansa_version} = 2;
+	$report{last_checked} = time;
+
+	state $mcpan  = MetaCPAN::Client->new();
+	my $mdist   = eval { $mcpan->release($perl_dist->{name}) };
+	if( $mdist ) {
+		# say dumper($mdist);
+		$report{repo} = $mdist->resources->{repository}{url} // $mdist->resources->{repository}{web};
+		$report{latest_version} = $mdist->version;
+		}
+	else {
+		$report{repo} = $report{latest_version} = undef;
+		}
+
 	foreach my $advisory ( $advisories->@* ) {
-		my $report = make_report( $data->{name}, $advisory, $perl_dist->{name}, $affected );
-		$report->{generated}{from} = $file;
-		$report->{generated}{date} = scalar localtime;
-		push @reports, $report if defined $report;
+		my $advisory = make_report( $data->{name}, $perl_dist->{name}, $advisory, $affected );
+		push $report{advisories}->@*, $advisory if defined $advisory;
 		}
-	my $output_file = yaml_dump(\@reports);
+
+	my $output_file = yaml_dump(\%report);
 	}
 
 sub dumper { state $rc = require Data::Dumper; Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Dump }
@@ -182,15 +202,15 @@ (@args)
 	my @files = glob( catfile($report_dir, '*.yml') );
 	}
 
-sub make_report ( $name, $advisory, $perl_dist_name, $affected ) {
-	state @copy_keys = qw(cve description references reported severity);
+sub make_report ( $name, $perl_dist_name, $advisory, $affected ) {
+	state @copy_keys = qw(cve description references reported severity github_security_advisory);
+
 	my %report = map { $_ => $advisory->{$_} } @copy_keys;
-	$report{cves} = delete $report{cve};
+	$report{cves} = [ delete $report{cve} ];
 
+	$report{id} = sprintf 'CPANSA-%s-%s-%s',
+		$perl_dist_name, $report{cves}[0] =~ s/\ACVE-//r, $name;
 	$report{affected_versions} = $affected->{perl_module_versions};
-	$report{distribution}      = $perl_dist_name;
-	$report{id}                = sprintf 'CPANSA-%s-%s-%s',
-		$perl_dist_name, $report{cves} =~ s/\ACVE-//r, $name;
 	error( "empty affected_versions in $report{id}" )
 		unless defined $report{affected_versions};
 
@@ -219,12 +239,12 @@ ( $report )
 	state $rc = require YAML;
 	state $n = 0;
 	my $file = sprintf '%s/report-%04d.yml', $Report_dir, ++$n;
+	say "==== $file\n", dumper($report);
 	my $result = eval { YAML::DumpFile($file, $report) };
 	if( $@ ) { error( "error dumping $file: $@" ) }
 	return $file;
 	}
 
-
 BEGIN {
 	my $original = select(STDOUT); $|++;
 	select(STDERR); $|++;