File Coverage

script/cpan-audit

Criterion	Covered	Total	%
statement	132	154	85.7
branch	30	52	57.6
condition	8	16	50.0
subroutine	21	23	91.3
pod			n/a
total	191	245	77.9

#!/usr/bin/env perl
use v5.10;
use strict;
use warnings;
use open qw(:std :encoding(UTF-8));

use IO::Interactive qw(is_interactive);

use CPAN::Audit;

our $VERSION = "1.503";

__PACKAGE__->run( @ARGV ) unless caller;

# The exit code indicates the number of advisories, up to this max
# since we have a limited number of exit codes.
use constant ADVISORY_COUNT_MAX => 62;

use constant EXIT_NORMAL =>  0;
use constant EXIT_ZERO   =>  0;
use constant EXIT_USAGE  =>  2;
use constant EXIT_BASE   => 64;

my $output_table;
BEGIN {
	$output_table = {
		text    => \&format_text,
		dumper  => \&format_dump,
		json    => \&format_json,
		default => \&format_text,
	};
}

sub format_advisory {
    my ($advisory) = @_;
    my $s = "  __BOLD__* $advisory->{id}__RESET__\n";
       $s .= "    $advisory->{description}\n";

    if ( $advisory->{affected_versions} ) {
    	my @v = ref $advisory->{affected_versions} ? @{$advisory->{affected_versions}} : $advisory->{affected_versions};
    	my $first = shift @v;
        $s .= "    Affected range: $first\n";
        $s .= "                    $_\n" for @v;
    }

    if ( $advisory->{fixed_versions} ) {
    	my @v = ref $advisory->{fixed_versions} ? @{$advisory->{fixed_versions}} : $advisory->{fixed_versions};
    	my $first = shift @v;
    	$first //= '';
        $s .= "    Fixed range:    $first\n";
        $s .= "                    $_\n" for @v;
    }

    if ( $advisory->{cves} ) {
        $s .=  "\n    CVEs: ";
        $s .=  join ', ', @{ $advisory->{cves} };
        $s .=  "\n";
    }

    if ( $advisory->{references} ) {
        $s .=  "\n    References:\n";
        foreach my $reference ( @{ $advisory->{references} || [] } ) {
            $s .=  "    $reference\n";
        }
    }

    $s .=  "\n";
    return $s;
}

use Data::Dumper;
sub dumper { Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Dump }
sub format_dump {
	my( $result ) = @_;
	return dumper($result);
}

sub format_json {
	state $rc = require JSON;
	my( $result ) = @_;
	return JSON::encode_json($result);
}

sub format_text {
	my( $result, $opts ) = @_;
	my $s = '';

	foreach my $distname ( keys %{ $result->{dists} } ) {
		my $advisories = $result->{dists}{$distname}{advisories};
		$s .= sprintf("__RED__%s (%s %s) has %d advisor%s__RESET__\n",
			$distname,
			($result->{meta}{command} eq 'installed' ? 'have' : 'requires'),
			$result->{dists}{$distname}{version},
			scalar(@$advisories),
			(scalar(@$advisories) == 1 ? 'y' : 'ies'),
		);

		foreach my $advisory ( @$advisories ) {
			$s .= format_advisory( $advisory );
		}
	}

	$s .= "\n" if length $s;

    if ( $opts->{'no-color'} or $opts->{'ascii'} ) {
        $s =~ s{__BOLD__}{}g;
        $s =~ s{__GREEN__}{}g;
        $s =~ s{__RED__}{}g;
        $s =~ s{__RESET__}{}g;
    }
    else {
        $s =~ s{__BOLD__}{\e[39;1m}g;
        $s =~ s{__GREEN__}{\e[32m}g;
        $s =~ s{__RED__}{\e[31m}g;
        $s =~ s{__RESET__}{\e[0m}g;

        $s .= "\e[0m" if length $s;
    }

	return $s;
}

sub output_version {
	my( $class, $exit_code ) = @_;

	print <<"HERE";
$0 version $VERSION using:
\tCPAN::Audit      @{[ CPAN::Audit->VERSION ]}
\tCPAN::Audit::DB  @{[ CPAN::Audit::DB->VERSION // '' ]} (deprecated)
\tCPANSA::DB       @{[ ( eval { require CPANSA::DB } && CPANSA::DB->VERSION) // '' ]}

HERE

	exit($exit_code);
}

sub run {
	my( $class, @args ) = @_;

	my( $opts ) = $class->process_options( \@args );
	unless( ! $opts->{interactive} ) {
		$opts->{ascii} = 1;
		$opts->{no_color} //= 1;
	}

	$class->usage(EXIT_NORMAL)          if $opts->{help};
	$class->output_version(EXIT_NORMAL) if $opts->{version};

	if( $opts->{fresh_check} ) {
		require CPAN::Audit::FreshnessCheck;
		CPAN::Audit::FreshnessCheck->import
		}

	my $command = shift @args;
	$class->usage(EXIT_USAGE) unless defined $command;

	my %extra = (
		interactive => is_interactive(),
		);

	my $audit = CPAN::Audit->new( %$opts, %extra );

	my $result = $audit->command( $command, @args );

	if( @{ $result->{errors} } > 0 ) {
		my $message = join "\n", map "Error: $_", @{ $result->{errors} };
		unless( $opts->{'no-color'} ) {
			$message = "\e[31m" . $message . "\e[0m"
		}
		print STDERR $message;
		exit 255;
	}

	my( $output_type ) = grep { $opts->{$_} } qw(json);
	my $sub = $output_table->{$output_type // 'default'};

	my $output = $sub->( $result, $opts );
	if( $command eq 'show' ) {
		$output =~ s/\A.*\n//;
	}

	print $output;

	my $advisory_count = $result->{meta}{total_advisories};
	$advisory_count = ADVISORY_COUNT_MAX if $advisory_count > ADVISORY_COUNT_MAX;

	my $exit_code = do {
		if( $opts->{exit_zero} )      { EXIT_ZERO }
		elsif( $advisory_count == 0 ) { EXIT_NORMAL }
		else                          { EXIT_BASE + $advisory_count }
		};

	exit( $exit_code );
	}

sub process_options {
	my( $class, $args ) = @_;
	require Getopt::Long;

	my $options = {};

	my %params = ();
	my $params = {
		'ascii'           => \$params{ascii},
		'f|fresh'         => \$params{fresh_check},
		'help|h'          => \$params{help},
		'json'            => \$params{json},
		'no-color'        => \$params{no_color},
		'no-corelist'     => \$params{no_corelist},
		'perl'            => \$params{include_perl},
		'quiet|q'         => \$params{quiet},
		'verbose|v'       => \$params{verbose},
		'version'         => \$params{version},
		'exclude=s@'      => \$params{exclude},
		'exclude-file=s@' => \$params{exclude_file},
		'modules=s@'      => \$params{modules},
                'exit-zero'       => \$params{exit_zero},
		};

	my $ret = Getopt::Long::GetOptionsFromArray( $args, $options, %$params )
		or $class->usage(EXIT_USAGE);

	$params{quiet} = 1 if $params{json};

	\%params;
	}

sub usage {
	require Pod::Usage;
	require FindBin;

	my( $class, $exit_code ) = @_;
	no warnings qw(once);
	Pod::Usage::pod2usage( -input => $FindBin::Bin . "/" . $FindBin::Script );
	print <<'HERE';
NAME
    cpan-audit - Audit CPAN modules

SYNOPSIS
    cpan-audit [command] [options]

    Commands:

        module         [version range]    audit module with optional version range (all by default)
        modules        [version range]    audit module list with optional version range (all by default)
        dist|release   [version range]    audit distribution with optional version range (all by default)
        deps           [directory]        audit dependencies from the directory (. by default)
        installed                         audit all installed modules
        show           [advisory id]      show information about specific advisory

    Options:

        --ascii               use ascii output
        --fresh|f             check the database for freshness (CPAN::Audit::FreshnessCheck)
        --help|h              show the help message and exit
        --no-color            switch off colors
        --no-corelist         ignore modules bundled with perl version
        --perl                include perl advisories
        --quiet               be quiet (overrules --verbose)
        --verbose             be verbose (off if --quiet in effect)
        --version             show the version and exit
        --exit-zero           always exit with 0 even if advisories are reported
        --exclude        exclude/ignore the specified advisory/cve (multiple)
        --exclude-file  read exclude/ignore patterns from file
        --json                output JSON

    Examples:

        cpan-audit dist Catalyst-Runtime
        cpan-audit dist Catalyst-Runtime 7.0
        cpan-audit dist Catalyst-Runtime '>5.48'

        cpan-audit module Catalyst 7.0

        cpan-audit modules "Catalyst;7.0" "Mojolicious;>8.40,<9.20"

        cpan-audit deps .
        cpan-audit deps /path/to/distribution

        cpan-audit installed
        cpan-audit installed local/
        cpan-audit installed local/ --exclude CVE-2011-4116
        cpan-audit installed local/ --exclude CVE-2011-4116 --exclude CVE-2011-123
        cpan-audit installed local/ --exclude-file ignored-cves.txt

        cpan-audit installed --json

        cpan-audit installed --json --exit-zero

        cpan-audit show CPANSA-Mojolicious-2018-03

DESCRIPTION
    "cpan-audit" is a command line application that checks the modules or
    distributions for known vulnerabilities. It is using its internal
    database that is automatically generated from a hand-picked database
    .

    "cpan-audit" does not connect to anything, that is why it is important
    to keep it up to date. Every update of the internal database is released
    as a new version. Ensure that you have the latest database by updating
    CPAN::Audit frequently; the database can change daily. You can use
    enable a warning for a possibly out-of-date database by adding
    "--fresh", which warns if the database version is older than a month:

            % cpan-audit --fresh ...
            % cpan-audit -f ...

            % env CPAN_AUDIT_FRESH_DAYS=7 cpan-audit -f ...

  Finding dependencies
    "cpan-audit" can automatically detect dependencies from the following
    sources:

    "Carton"
        Parses cpanfile.snapshot file and checks the distribution versions.

    cpanfile
        Parses cpanfile taking into account the required versions.

    It is assumed that if the required version of the module is less than a
    version of a release with a known vulnerability fix, then the module is
    considered affected.

  JSON data
    If you request JSON output, the data looks like

        {
          "meta" : {
              ... meta information ...
          "dists": {
            "": {
              ... distribution info ...
            }
          }
          "errors" : [
            ... list of errors - if any ...
          ]
        }

   Meta information
    The meta data contains information about the run of "cpan-audit".

        {
          "args": [
            "Mojo::File",
            "Mojo::UserAgent",
            "LWP::UserAgent"
          ],
          "cpan_audit": {
            "version": "20230601.002"
          },
          "total_advisories": 19,
          "command": "modules"
        }

    These information are shown

    *   cpan_audit

        The version of "cpan_audit" that is used for the audit

    *   command

        The command of "cpan_audit" that was run

    *   args

        Arguments for the command

    *   total_advisories

        Number of found advisories

   Distribution information
    For each distribution where at least one advisory was found, the JSON
    looks like:

        "Dist-Name": {
          "queried_modules": [
            "Queried::Namespace"
          ],
          "version": "Any",
          "advisories": [
            {
              ... advisory data as in the audit database ...
            },
              ... more advisories ...
          ]
        },

    The advisory data is basically the data from the database. So this
    depends on what is known for the given advisory.

    The distribution information contains:

    *   version

        The version (range) that is checked for advisories. If there's no
        version specified, all versions are checked and the version is
        report as "Any".

    *   queried_modules

        The actual namespaces queried, either from the command line or
        another source, such as a cpanfile.

    *   advisories

        A list of all vulnerabilities found for the version range

  Exit values
    In prior versions, "cpan-audit" exited with the number of advisories it
    found. Starting with 1.001, if there are advisories found, "cpan-audit"
    exits with 64 added to that number. The maximum number of reported
    advisories is 62, since values over 126 are spoken for.

    If the option "--exit-zero" is set "cpan-audit" exits always with a
    normal exit code (0). This allows to use "cpan-audit" in build
    environments together with bash exit mode activated ("set -e").

    *   0 - no advisories found

    *   2 - problem with program invocation, such as bad switches or values

    *   64+n - advisories found. Subtract 64 to get the advisory count, up
        to 62 advisories

    *   255 - unspecified program error

LICENSE
    Copyright (C) Viacheslav Tykhanovskyi.

    This library is free software; you can redistribute it and/or modify it
    under the same terms as Perl itself.HERE
HERE

	exit( $exit_code );
	}

__END__