#!/usr/bin/env perl
use v5.10;
use strict;
use warnings;

use IO::Interactive qw(is_interactive);

use CPAN::Audit;

our $VERSION = "1.301";

__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_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} ) {
        $s .= "    Affected range: $advisory->{affected_versions}\n";
    }

    if ( $advisory->{fixed_versions} ) {
        $s .=  "    Fixed range: $advisory->{fixed_versions}\n";
    }

    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( $exit_code ) = @_;
	print "$0 version $VERSION using:\n\tCPAN::Audit     @{[ CPAN::Audit->VERSION ]}\n\tCPAN::Audit::DB @{[ CPAN::Audit::DB->VERSION ]}\n";
	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( $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},
		};

	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( $exit_code ) = @_;
	no warnings qw(once);
	Pod::Usage::pod2usage( -input => $FindBin::Bin . "/" . $FindBin::Script );
	exit( $exit_code );
	}

__END__

=head1 NAME

cpan-audit - Audit CPAN modules

=head1 SYNOPSIS

cpan-audit [command] [options]

Commands:

    module         [version range]    audit module 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
    --freshcheck|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
    --exclude <str>       exclude/ignore the specified advisory/cve (multiple)
    --exclude-file <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 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 show CPANSA-Mojolicious-2018-03

=head1 DESCRIPTION

C<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
L<https://github.com/briandfoy/cpan-security-advisory>.

C<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 L<CPAN::Audit> frequently; the database can change daily.
You can use enable a warning for a possibly out-of-date database by
adding C<--freshcheck>, which warns if the database version is older
than a month:

	% cpan-audit --freshcheck ...
	% cpan-audit -f ...

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

=head2 Finding dependencies

C<cpan-audit> can automatically detect dependencies from the following
sources:

=over

=item C<Carton>

Parses F<cpanfile.snapshot> file and checks the distribution versions.

=item F<cpanfile>

Parses F<cpanfile> taking into account the required versions.

=back

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.

=head2 Exit values

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

=over 4

=item * 0 - normal operation

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

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

=item * 255 - program error

=back

=head1 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.

=cut
