App-CPAN-SBOM

 view release on metacpan or  search on metacpan

lib/App/CPAN/SBOM.pm  view on Meta::CPAN

use CPAN::Audit;
use CPAN::Meta;
use Cpanel::JSON::XS qw(encode_json);
use Data::Dumper;
use File::Basename;
use File::Spec;
use Getopt::Long qw(GetOptionsFromArray :config gnu_compat);
use HTTP::Tiny;
use MetaCPAN::Client;
use MIME::Base64;
use Pod::Usage qw(pod2usage);
use URI::PackageURL;

use SBOM::CycloneDX::Component;
use SBOM::CycloneDX::ExternalReference;
use SBOM::CycloneDX::Hash;
use SBOM::CycloneDX::License;
use SBOM::CycloneDX::Metadata;
use SBOM::CycloneDX::OrganizationalContact;
use SBOM::CycloneDX::Util qw(cpan_meta_to_spdx_license cyclonedx_tool cyclonedx_component);
use SBOM::CycloneDX::Vulnerability::Affect;
use SBOM::CycloneDX::Vulnerability::Rating;
use SBOM::CycloneDX::Vulnerability::Source;
use SBOM::CycloneDX::Vulnerability;
use SBOM::CycloneDX;

our $VERSION = '1.04';


sub DEBUG { $ENV{SBOM_DEBUG} || 0 }

sub cli_error {
    my ($error, $code) = @_;
    $error =~ s/ at .* line \d+.*//;
    say STDERR "ERROR: $error";
    return $code || 1;
}

sub run {

    my (@args) = @_;

    my %options = ();

    GetOptionsFromArray(
        \@args, \%options, qw(
            help|h
            man
            v
            debug|d

            output|o=s

            meta=s
            distribution=s

            maxdepth=i

            vulnerabilities!
            validate!

            project-meta=s
            project-type=s
            project-author=s@
            project-description=s
            project-directory=s
            project-license=s
            project-name=s
            project-version=s

            server-url=s
            api-key=s
            skip-tls-check
            project-id=s
            parent-project-id=s

            cyclonedx-spec-version=s

            list-spdx-licenses
        )
    ) or pod2usage(-verbose => 0);

    pod2usage(-exitstatus => 0, -verbose => 2) if defined $options{man};
    pod2usage(-exitstatus => 0, -verbose => 0) if defined $options{help};

    $options{'project-meta'} //= $options{meta};

    if (defined $options{v}) {
        return show_version();
    }

    if ($options{'list-spdx-licenses'}) {
        say $_ for (sort @{SBOM::CycloneDX::Enum->SPDX_LICENSES});
        return 0;
    }

    unless ($options{distribution} || $options{'project-meta'} || $options{'project-directory'}) {
        pod2usage(-exitstatus => 0, -verbose => 0);
    }

    $options{maxdepth} //= 1;
    $options{validate} //= 1;

    if (defined $options{debug}) {
        $ENV{SBOM_DEBUG} = 1;
    }

    my $bom = SBOM::CycloneDX->new;

    my $spec_version = '1.6';

    if (defined $options{'cyclonedx-spec-version'}) {
        $spec_version = $options{'cyclonedx-spec-version'};
    }

    if ($spec_version >= 1.2 && $spec_version <= 1.7) {
        $bom->spec_version($spec_version);
    }

    if (defined $options{distribution}) {

        my ($distribution, $version) = split '@', $options{distribution};

        return cli_error('Missing distribution version') unless $version;

        make_sbom_from_dist(bom => $bom, distribution => $distribution, version => $version, options => \%options);
    }

    if (defined $options{'project-directory'} || defined $options{'project-meta'}) {
        make_sbom_from_project(bom => $bom, options => \%options);
    }

    $bom->metadata->timestamp(time);
    $bom->metadata->tools->push(cyclonedx_tool());

    my $output_file = $options{output} // 'bom.json';

    say STDERR "Save SBOM to $output_file";

    open my $fh, '>', $output_file or Carp::croak "Failed to open file: $!";
    say $fh $bom->to_string;
    close $fh;

    if ($options{validate}) {
        my @errors = $bom->validate;
        say STDERR $_ foreach (@errors);
    }

    if (defined $options{'server-url'} && defined $options{'api-key'}) {
        submit_bom(bom => $bom, options => \%options);
    }

}

sub show_version {

    (my $progname = $0) =~ s/.*\///;

    say <<"VERSION";
$progname version $VERSION

Copyright 2025-2026, Giuseppe Di Terlizzi <gdt\@cpan.org>

This program is part of the "App-CPAN-SBOM" distribution and is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.

Complete documentation for $progname can be found using 'man $progname'
or on the internet at <https://metacpan.org/dist/App-CPAN-SBOM>.
VERSION

    return 0;

}

sub make_sbom_from_project {

    my (%params) = @_;

    my $audit_discover = CPAN::Audit::Discover->new;

    my $bom     = $params{bom};
    my $options = $params{options} || {};

    my @META_FILES = (qw[META.json META.yml MYMETA.json MYMETA.yml]);

    say STDERR 'Generate SBOM';

    my $project_type        = $options->{'project-type'} || 'library';
    my $project_directory   = File::Spec->rel2abs($options->{'project-directory'});
    my $project_meta        = $options->{'project-meta'}    || $options->{'meta'};
    my $project_name        = $options->{'project-name'}    || basename($project_directory);
    my $project_version     = $options->{'project-version'} || 0;
    my $project_description = $options->{'project-description'};
    my $project_license     = $options->{'project-license'};
    my $project_author      = $options->{'project-author'} || [];

    if ($project_directory) {
        return cli_error('Directory not found') unless -d $project_directory;
    }

    unless ($project_meta) {
        foreach (@META_FILES) {
            my $meta_file = File::Spec->catfile($project_directory, $_);
            if (-f $meta_file) {
                $project_meta = $meta_file;

lib/App/CPAN/SBOM.pm  view on Meta::CPAN

    add_authors_to_component(bom => $bom, component => $root_component, authors => \@authors);

    if ($project_description) {
        $root_component->description($project_description);
    }

    # Add root BOM component in metadata
    $bom->metadata->component($root_component);

    # Find dependencies from "cpanfile.snapshot" or "cpanfile"
    if (my @audit_deps = $audit_discover->discover($project_directory)) {
        @dependencies = @audit_deps;
    }

    foreach my $dependency (@dependencies) {

        make_dep_compoment(
            module           => $dependency->{module},
            dist             => $dependency->{dist},
            version          => $dependency->{version},
            bom              => $bom,
            parent_component => $root_component,
            maxdepth         => $options->{maxdepth}
        );
    }

    return $root_component;

}

sub make_sbom_from_dist {

    my (%params) = @_;

    my $distribution = $params{distribution};
    my $version      = $params{version};
    my $bom          = $params{bom};
    my $options      = $params{options} || {};

    say STDERR "Generate SBOM for $distribution\@$version";

    my $mcpan        = MetaCPAN::Client->new;
    my $release_data = $mcpan->release({all => [{distribution => $distribution}, {version => $version}]});

    my $dist_data = $release_data->next;

    unless ($dist_data) {
        Carp::carp("Unable to find release ($distribution\@$version) in Meta::CPAN");
        return;
    }

    my $metadata = $dist_data->metadata;

    my @authors = make_authors($metadata->{author});

    my $purl = URI::PackageURL->new(
        type       => 'cpan',
        name       => $dist_data->distribution,
        version    => $dist_data->version,
        qualifiers => {author => $dist_data->author},
        validate   => 0
    );

    my @external_references = make_external_references($dist_data->metadata->{resources});

    my $license_name = join ' AND ', @{$metadata->{license}};
    my $license_id   = cpan_meta_to_spdx_license($license_name) || 'NONE';
    my $license_info = ($license_id ne 'NONE') ? {id => $license_id} : {name => $license_name};

    my $bom_license = SBOM::CycloneDX::License->new($license_info);

    my $root_component = SBOM::CycloneDX::Component->new(
        type                => 'library',
        name                => $dist_data->name,
        version             => $dist_data->version,
        licenses            => [$bom_license],
        bom_ref             => $purl->to_string,
        purl                => $purl,
        external_references => \@external_references
    );

    add_authors_to_component(bom => $bom, component => $root_component, authors => \@authors);

    if (my $abstract = $dist_data->abstract) {
        $root_component->description($abstract);
    }

    $bom->metadata->component($root_component);

    if ($options->{vulnerabilities}) {
        make_vulnerabilities(
            bom          => $bom,
            distribution => $dist_data->distribution,
            version      => $dist_data->version,
            bom_ref      => $purl->to_string
        );
    }

    foreach my $dependency (@{$dist_data->dependency}) {
        if ($dependency->{phase} eq 'runtime' and $dependency->{relationship} eq 'requires') {
            next if ($dependency->{module} eq 'perl');

            make_dep_compoment(
                module           => $dependency->{module},
                bom              => $bom,
                parent_component => $root_component,
                maxdepth         => $options->{maxdepth}
            );

        }
    }

    return $root_component;

}

sub make_external_references {

    my $resources = shift;

    my @external_references = ();

lib/App/CPAN/SBOM.pm  view on Meta::CPAN

        my $module_data = $mcpan->module($module);

        unless ($module_data) {
            Carp::carp("Unable to find module ($module) in Meta::CPAN");
            return;
        }

        $author //= $module_data->author;

        $distribution = $module_data->distribution;

        if (!$version) {
            $version = $module_data->version;
        }

        # Standardize the core perl distribution version
        if ($distribution eq 'perl') {
            $version =~ s/^v?5\.([1-9]\d+)(.*)$/5.0$1*/;
        }

    }

    $version =~ s/^v//;

    my $release_data = $mcpan->release({
        either => [
            {all => [{distribution => $distribution}, {version => $version}]},
            {all => [{distribution => $distribution}, {version => "v$version"}]},
        ]
    });

    my $dist_data = $release_data->next;

    DEBUG
        and say STDERR sprintf '-- %s[%d] Collect distribution %s@%s info (parent component %s)',
        ("    " x ($depth - 1)), $depth, $distribution, $version, $parent_component->bom_ref;

    unless ($dist_data) {
        Carp::carp("Unable to find release ($distribution\@$version) in Meta::CPAN");
        return;
    }

    my $metadata = $dist_data->metadata;

    $author //= $dist_data->author;

    my @authors = make_authors($metadata->{author});

    # Distribution License
    my $license_name = join ' AND ', @{$dist_data->metadata->{license}};
    my $license_id   = cpan_meta_to_spdx_license($license_name) || 'NONE';
    my $license      = ($license_id ne 'NONE') ? {id => $license_id} : {name => $license_name};

    my $bom_license = SBOM::CycloneDX::License->new($license);

    my $purl = URI::PackageURL->new(
        type       => 'cpan',
        name       => $distribution,
        version    => $version,
        qualifiers => {author => $author},
        validate   => 0
    );

    my @ext_refs = make_external_references($dist_data->metadata->{resources});

    my $hashes = SBOM::CycloneDX::List->new;

    if (my $checksum = $dist_data->checksum_sha256) {
        $hashes->add(SBOM::CycloneDX::Hash->new(alg => 'SHA-256', content => $checksum));
    }

    if (my $checksum = $dist_data->checksum_md5) {
        $hashes->add(SBOM::CycloneDX::Hash->new(alg => 'MD5', content => $checksum));
    }

    my $component = SBOM::CycloneDX::Component->new(
        type                => 'library',
        name                => $distribution,
        version             => $version,
        licenses            => [$bom_license],
        bom_ref             => $purl->to_string,
        purl                => $purl,
        hashes              => $hashes,
        external_references => \@ext_refs,
    );

    add_authors_to_component(bom => $bom, component => $component, authors => \@authors);

    if (my $abstract = $dist_data->abstract) {
        $component->description($abstract);
    }

    if (!$bom->get_component_by_bom_ref($purl->to_string)) {
        $bom->components->push($component);
    }

    if ($add_vulns) {
        make_vulnerabilities(
            bom          => $bom,
            distribution => $distribution,
            version      => $version,
            bom_ref      => $purl->to_string
        );
    }

    $bom->add_dependency($parent_component, [$component]);

    if ($depth < $maxdepth) {

        $depth++;

        foreach my $dependency (@{$dist_data->dependency}) {
            if ($dependency->{phase} eq 'runtime' and $dependency->{relationship} eq 'requires') {
                next if ($dependency->{module} eq 'perl');
                make_dep_compoment(
                    module           => $dependency->{module},
                    bom              => $bom,
                    parent_component => $component,
                    depth            => $depth
                );
            }