generate_sbom

#!/usr/bin/perl

################################################################
#
# Copyright (c) 2023 SUSE Linux LLC
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

BEGIN {
  unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
}

use strict;

use File::Find;
use File::Temp;

use Digest::SHA;
use Digest::MD5;

use Build;
use Build::Rpm;
use Build::Deb;
use Build::SimpleJSON;

my $tool_name = 'obs_build_generate_sbom';
my $tool_version = '1.0';

my $config = {};

sub unify {
  my %h = map {$_ => 1} @_; 
  return grep(delete($h{$_}), @_);
}

sub urlencode {
  my ($str, $iscgi) = @_;
  if ($iscgi) {
    $str =~ s/([\000-\037<>;\"#\?&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge;
    $str =~ tr/ /+/;
  } else {
    $str =~ s/([\000-\040<>;\"#\?&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge;
  }
  return $str;
}

sub rfc3339time {
  my ($t) = @_;
  my @gt = gmtime($t || time());
  return sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ", $gt[5] + 1900, $gt[4] + 1, @gt[3,2,1,0];
}

sub sha256file {
  my ($fn) = @_;
  my $ctx = Digest::SHA->new(256);
  eval { $ctx->addfile($fn) };
  die("$fn: $@\n") if $@;
  return $ctx->hexdigest();
}

sub system_chroot {
  my ($root, @args) = @_;
  my $pid = 0;
  if ($args[0] eq 'exec') {
    shift @args;
  } else {
    $pid = fork();
    die("fork: $!\n") unless defined $pid;
  }
  if (!$pid) {
    if ($args[0] eq 'quiet') {
      shift @args;
      open(STDOUT, '>>', '/dev/null');
      open(STDERR, '>>', '/dev/null');
    }
    if ($args[0] eq 'stdout') {
      open(STDOUT, '>', $args[1]) || die("$args[1]: $!\n");
      splice(@args, 0, 2);
    }
    !$root || chroot($root) || die("chroot $root: $!\n");
    exec(@args);
    die("exec $args[0]: $!\n");
  }
  die unless waitpid($pid, 0) == $pid;
  return $?;
}

sub popen_chroot {
  my ($root, @args) = @_;

  my $fd;
  if (!$root) {
    open($fd, '-|', @args) || die("open: $!\n");
    return $fd;
  }
  my $pid = open($fd, '-|');
  die("open: $!\n") unless defined $pid;
  if ($pid == 0) {
    !$root || chroot($root) || die("chroot $root: $!\n");
    exec(@args);
    die("exec $args[0]: $!\n");
  }
  return $fd;
}

sub can_run {
  my ($root, $fname) = @_;
  return 0 if $root && $>;
  return -x "$root$fname";
}

sub systemq {
  my $pid = fork();
  die("fork: $!\n") unless defined $pid;
  if (!$pid) {
    open(STDOUT, '>', '/dev/null') || die("/dev/null: $!\n");
    exec @_;
    die("$_[0]: $!\n");
  }
  waitpid($pid, 0) == $pid || die("waitpid: $!\n");
  exit($?) if $?;
}

sub uncompress_container {
  my ($container, $outfile) = @_;
  my @decompressor;
  if ($container =~ /\.tar$/) {
    push @decompressor, 'cat';
  } elsif ($container =~ /\.tar\.gz$/) {
    push @decompressor, 'gunzip';
  } elsif ($container =~ /\.tar\.xz$/) {
    push @decompressor, 'xzdec';
  } else {
    die("$container: unknown format\n");
  }
  my $pid = fork();
  die("fork: $!\n") unless defined $pid;
  if (!$pid) {
    open(STDIN, '<', $container) || die("$container: $!\n");
    open(STDOUT, '>', $outfile) || die("$outfile: $!\n");
    exec @decompressor;
    die("$decompressor[0]: $!\n");
  }
  waitpid($pid, 0) == $pid || die("waitpid: $!\n");
  exit($?) if $?;
}

sub unpack_container {
  my ($dir, $container) = @_;
  uncompress_container($container, "$dir/cont");
  systemq('skopeo', 'copy', "docker-archive:$dir/cont", "oci:$dir/image:latest");
  unlink("$dir/cont");
  my @rootless;
  push @rootless, '--rootless' if $>;
  systemq('umoci', 'unpack', @rootless, '--image', "$dir/image:latest", "$dir/unpack");
  return "$dir/unpack/rootfs";
}

sub dump_rpmdb {
  my ($root, $outfile) = @_;
  my $dbpath;
  for my $phase (0, 1) {
    if (can_run($root, '/usr/bin/rpmdb')) {
      # check if we have the exportdb option
      if (system_chroot($root, 'quiet', '/usr/bin/rpmdb', '--exportdb', '--version') == 0) {
        if ($dbpath) {
          system_chroot($root, 'stdout', $outfile, '/usr/bin/rpmdb', '--dbpath', $dbpath, '--exportdb');
        } else {
          system_chroot($root, 'stdout', $outfile, '/usr/bin/rpmdb', '--exportdb');
        }
        exit($?) if $?;
        return;
      }
    }
    # try to get the dbpath from the root if we can
    if (!$dbpath && can_run($root, '/usr/bin/rpm')) {
      my $fd = popen_chroot($root, '/usr/bin/rpm', '--eval', '%_dbpath');
      my $path = <$fd>;
      close($fd);
      chomp $path;
      $dbpath = $path if $path && $path =~ /^\//;
    }
    $dbpath ||= '/var/lib/rpm';           # guess
    # try to dump with rpmdb_dump
    if (-s "$root$dbpath/Packages" && can_run($root, '/usr/lib/rpm/rpmdb_dump')) {
      my $outfh;
      open($outfh, '>', $outfile) || die("$outfile: $!\n");
      my $fd = popen_chroot($root, '/usr/lib/rpm/rpmdb_dump', "$dbpath/Packages");
      while (<$fd>) {
	next unless /^\s*[0-9a-fA-F]{8}/;
	chomp;
	my $v = <$fd>;
	die("unexpected EOF\n") unless $v;
	chomp $v;
	substr($v, 0, 1, '') while substr($v, 0, 1) eq ' ';
	$v = pack('H*', $v);
	next if length($v) < 16;
	my ($il, $dl) = unpack('NN', $v);
	die("bad header length\n") unless length($v) == 8 + $il * 16 + $dl;
	die("print: $!\n") unless print $outfh pack('H*', '8eade80100000000');
	die("print: $!\n") unless print $outfh $v;
      }
      close($fd) || die("rpmdb_dump: $!\n");
      close($outfh) || die("close: $!\n");
      return;
    }

    last unless $root;
    # try with the system rpm and a dbpath
    $dbpath = "$root$dbpath";
    $root = '';
  }
  die("could not dump rpm database\n");
}

sub gen_filelist {
  my ($dir) = @_;
  my $fd;
  my $pid = open($fd, '-|');
  die("fork: $!\n") unless defined $pid;
  if (!$pid) {
    chdir($dir) || die("chdir $!\n");
    exec('find', '-print0');
    die("find: $!\n");
  }
  local $/ = "\0";
  my @files = <$fd>;
  chomp @files;
  close($fd) || die("find: $?\n");
  $_ =~ s/^\.\//\// for @files;
  $_ = {'name' => $_} for @files;
  for my $f (@files) {
    if (-l "$dir$f->{'name'}" || ! -f _) {
      $f->{'SKIP'} = 1;
      next;
    }
    $f->{'sha256sum'} = sha256file("$dir/$f->{'name'}");
  }
  return \@files;
}

sub read_rpm {
  my ($rpm) = @_;
  my %r = Build::Rpm::rpmq($rpm, qw{NAME VERSION RELEASE EPOCH ARCH LICENSE SOURCERPM DISTURL FILENAMES URL VENDOR FILEMODES FILEDIGESTS FILEDIGESTALGO SIGMD5});
  delete $r{$_} for qw{BASENAMES DIRNAMES DIRINDEXES};	# save mem
  for (qw{NAME VERSION RELEASE EPOCH ARCH LICENSE SOURCERPM DISTURL URL VENDOR FILEDIGESTALGO SIGMD5}) {
    next unless $r{$_};
    die("bad rpm entry for $_\n") unless ref($r{$_}) eq 'ARRAY' && @{$r{$_}} == 1;
    $r{$_} = $r{$_}->[0];
  }
  return \%r;
}

sub read_pkgs_rpmdb {
  my ($rpmhdrs) = @_;
  my $fd;
  open($fd, '<', $rpmhdrs) || die("$rpmhdrs: $!\n");
  my @rpms;
  while (1) {
    my $hdr = '';
    last unless read($fd, $hdr, 16) == 16;
    my ($il, $dl) = unpack('@8NN', $hdr);
    die("bad rpm header\n") unless $il && $dl;
    die("bad rpm header\n") unless read($fd, $hdr, $il * 16 + $dl, 16) == $il * 16 + $dl;
    push @rpms, read_rpm([ $hdr ]);
  }
  close($fd);
  @rpms = sort {$a->{'NAME'} cmp $b->{'NAME'} || $a->{'VERSION'} cmp $b->{'VERSION'} || $a->{'RELEASE'} cmp $b->{'RELEASE'}} @rpms;
  return \@rpms;
}

sub parse_debian_copyright_file {
  my ($root, $pkg) = @_;
  my $file = "$root/usr/share/doc/$pkg/copyright";
  local *F;
  return {} unless open(F, '<', $file);
  my $firstline = <F>;
  return {} unless $firstline && $firstline =~ /^Format: https?:\/\/www.debian.org\/doc\/packaging-manuals\/copyright-format\/1.0\//;

  my $crfound = 0;
  my @copyright;
  my @license;
  while(<F>) {
    chomp;
    s/\s+$//;
    if (/^Copyright:\s*(.*)$/) {
      $crfound = 1;
      push @copyright, $1 if $1 ne '';
    } elsif (/^License:\s*(.*)$/) {
      $crfound = 0;
      # TODO licenses has to match https://spdx.org/licenses/?
      push @license, $1 if $1 ne '';
    } elsif (/^(Files|Comment|Disclaimer|Source|Upstream-Name|Upstream-Contact):/) {
      $crfound = 0;
    } elsif (/^\s{1,}(.*)$/ and $crfound) {
      push @copyright, $1;
    }
  }
  close F;
  @copyright = unify(@copyright);
  @copyright = grep {!/^(\*No copyright\*|No copyright|none|\*unknown\*|unknown)$/} @copyright;
  @license = unify(@license);
  my %ret;
  $ret{'copyright'} = join('\n ', sort @copyright) if @copyright;
  $ret{'license'} = join(' AND ', sort @license) if @license;
  return \%ret;
}

sub read_deb {
  my ($root, $ctrl) = @_;
  my %res = Build::Deb::control2res($ctrl);
  return undef unless defined($res{'PACKAGE'}) && defined($res{'VERSION'});
  my %data;
  $data{'NAME'} = $res{'PACKAGE'};
  $data{'EVR'} = $res{'VERSION'};
  if ($res{'VERSION'} =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s) {
    $data{'EPOCH'} = $1 if defined $1;
    $data{'VERSION'} = $2;
    $data{'RELEASE'} = $3 if defined $3;
  }
  $data{'ARCH'} = $res{'ARCHITECTURE'} if defined $res{'ARCHITECTURE'};
  $data{'URL'} = $res{'HOMEPAGE'} if defined $res{'HOMEPAGE'};
  $data{'MAINTAINER'} = $res{'MAINTAINER'} if defined $res{'MAINTAINER'};
  my $license = parse_debian_copyright_file($root, $data{'NAME'});
  $data{'LICENSE'} = $license->{'license'} if defined $license->{'license'};
  $data{'COPYRIGHTTEXT'} = $license->{'copyright'} if defined $license->{'copyright'};
  if ($res{'STATIC-BUILT-USING'}) {
    $data{'BUILT_USING'} = [ split /,\s*/, $res{'STATIC-BUILT-USING'} ];
  } elsif ($res{'BUILT-USING'}) {
    $data{'BUILT_USING'} = [ split /,\s*/, $res{'BUILT-USING'} ];
  }
  return \%data;
}

sub read_deb_bu {
  my ($root, $name, $evr) = @_;
  my %data = ( 'NAME' => $name, 'EVR' => $evr );
  if ($evr =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s) {
    $data{'EPOCH'} = $1 if defined $1;
    $data{'VERSION'} = $2;
    $data{'RELEASE'} = $3 if defined $3;
  }
  my $license = parse_debian_copyright_file($root, $name);
  $data{'LICENSE'} = $license->{'license'} if defined $license->{'license'};
  $data{'COPYRIGHTTEXT'} = $license->{'copyright'} if defined $license->{'copyright'};
  return \%data;
}

sub read_pkgs_deb {
  my ($root) = @_;

  my $vendorstring = Build::Rpm::expandmacros($config, '%?vendor');
  my @pkgs;
  local *F;
  my %seen_pkg;
  my @bupkgs;
  if (open(F, '<', "$root/var/lib/dpkg/status")) {
    my $ctrl = '';
    while(<F>) {
      if ($_ eq "\n") {
	my $data = read_deb($root, $ctrl);
	if ($data) {
	  $data->{'VENDOR'} = $vendorstring if $vendorstring;
	  push @pkgs, $data;
	  $seen_pkg{"$data->{'NAME'}-$data->{'EVR'}"} = 1;
	  push @bupkgs, @{$data->{'BUILT_USING'}} if $data->{'BUILT_USING'};
	}
        $ctrl = '';
        next;
      }
      $ctrl .= $_;
    }
    close F;
  }
  # create stubs for missing BUILT_USING packages
  for my $bd (@bupkgs) {
    next unless $bd =~ /(.+)\s+\(\s*=\s*(.+)\s*\)/;
    next if $seen_pkg{"$1-$2"};
    my $data = read_deb_bu($root, $1, $2);
    if ($data) {
      $data->{'VENDOR'} = $vendorstring if $vendorstring;
      push @pkgs, $data;
      $seen_pkg{"$data->{'NAME'}-$data->{'EVR'}"} = 1;
    }
  }
  return \@pkgs;
}

sub read_pkgs_from_product_directory {
  my ($dir) = @_;
  my @rpms;
  my $addrpmfile = sub {
    my $fn = $File::Find::name;
    push @rpms, read_rpm($fn) if $fn =~ /\.rpm$/;
  };
  find($addrpmfile, $dir);
  return \@rpms;
}

sub read_pkgs_from_rpmmd {
  my ($primaryfile) = @_;

  require Build::Rpmmd;
  my $fh;
  if ($primaryfile =~ /\.gz$/) {
    open($fh, '-|', 'gunzip', '-dc', $primaryfile) || die("$primaryfile: $!\n");
  } else {
    open($fh, '<', $primaryfile) || die("$primaryfile: $!\n");
  }
  my @rpms;
  for my $pkg (@{Build::Rpmmd::parse($fh, undef, 'withlicense' => 1, 'withchecksum' => 1, 'withvendor' => 1, 'withurl' => 1)}) {
    my $r = {};
    for (qw{name epoch version release arch url vendor sourcerpm license checksum}) {
      $r->{uc($_)} = $pkg->{$_} if defined $pkg->{$_};
    }
    push @rpms, $r;
  }
  close($fh);
  return \@rpms;
}

sub read_dist {
  my ($dir) = @_;
  my %dist;
  my $fd;
  if (open($fd, '<', "$dir/etc/os-release") || open($fd, '<', "$dir/usr/lib/os-release")) {
    while(<$fd>) {
      chomp;
      next unless /\s*(\S+)=(.*)/;
      my $k = lc($1);
      my $v = $2;
      $v =~ s/\s+$//;
      $v =~ s/^\"(.*)\"$/$1/;
      if ($k eq 'id_like') {
        push @{$dist{$k}}, $v;
      } else {
        $dist{$k} = $v;
      }
    }
    close($fd);
  }
  return %dist ? \%dist : undef;
}

sub pkgtype_from_dist {
  my ($dist) = @_;
  return 'rpm' unless $dist && $dist->{'id'};
  return 'deb' if $dist->{'id'} eq 'debian';
  return 'deb' if grep { $_ eq "debian" } @{$dist->{'id_like'} || []};
  return 'rpm';
}

sub gen_purl {
  my ($p, $distro, $pkgtype) = @_;

  my $vr = $p->{'VERSION'};
  $vr = "$vr-$p->{'RELEASE'}" if defined $p->{'RELEASE'};
  my $vendor = lc($p->{'VENDOR'});
  $vendor =~ s/obs:\/\///; # third party OBS builds
  $vendor =~ s/\ .*//;     # eg. SUSE LLC...
  $vendor =~ s/\/?$/\//;
  my $purlurl = "pkg:".urlencode("$pkgtype/$vendor$p->{'NAME'}\@$vr").'?';
  $purlurl .= '&epoch='.urlencode($p->{'EPOCH'}) if $p->{'EPOCH'};
  $purlurl .= '&arch='.urlencode($p->{'ARCH'}) if $p->{'ARCH'};
  $purlurl .= '&upstream='.urlencode($p->{'SOURCERPM'}) if $p->{'SOURCERPM'};
  $purlurl .= '&distro='.urlencode($distro) if $distro;
  $purlurl =~ s/\?\&/\?/;
  $purlurl =~ s/\?$//;
  return $purlurl;
}

sub gen_uuid {
  my $uuid = pack('H*', '1e9d579964de4594a4e835719a1c259f');	# uuid ns
  $uuid = substr(Digest::SHA::sha1($uuid . Build::SimpleJSON::unparse($_[0], 'keepspecial' => 1)), 0, 16);
  substr($uuid, 6, 1, pack('C', unpack('@6C', $uuid) & 0x0f | 0x50));
  substr($uuid, 8, 1, pack('C', unpack('@8C', $uuid) & 0x3f | 0x80));
  return join('-', unpack("H8H4H4H4H12", $uuid));
}

sub gen_pkg_id {
  my ($p) = @_;
  if ($p->{'SIGMD5'}) {
    return unpack('H*', $p->{'SIGMD5'});
  } elsif ($p->{'CHECKSUM'}) {
    my $id = $p->{'CHECKSUM'};
    $id =~ s/.*://;
    return substr($id, 0, 32);
  }
  return Digest::MD5::md5_hex(Build::SimpleJSON::unparse($p));
}

##################################################################################################
#
# CycloneDX support
#

my $cyclonedx_json_template_component = {
  '_order' => [ qw{bom-ref type name version description cpe purl externalReferences properties } ],
  'externalReferences' => { '_order' => [ qw{url comment type} ] },
};

my $cyclonedx_json_template = {
  '_order' => [ qw{bomFormat specVersion serialNumber version metadata components services externalReferences dependencies compositions vulnerabilities signature} ],
  'version' => 'number',
  'metadata' => {
    '_order' => [ qw{timestamp tools component} ],
    'tools' => { '_order' => [ qw{vendor name version } ] }.
    'component' => $cyclonedx_json_template_component,
  },
  'components' => $cyclonedx_json_template_component,
  'dependencies' => { '_order' => [ qw{ref dependsOn} ] }
};

sub cyclonedx_encode_pkg {
  my ($p, $distro, $pkgtype) = @_;
  my $vr = $p->{'VERSION'};
  $vr = "$vr-$p->{'RELEASE'}" if defined $p->{'RELEASE'};
  my $cyc = {
    'type' => 'library',
    'name' => $p->{'NAME'},
    'version' => $vr,
  };
  $cyc->{'publisher'} = $p->{'VENDOR'} if $p->{'VENDOR'};
  my $license = $p->{'LICENSE'};
  if ($license) {
    $license =~ s/ and / AND /g;
    if ($license =~ /\s+/) {
      push @{$cyc->{'licenses'}}, { 'expression' => $license };
    } else {
      push @{$cyc->{'licenses'}}, { 'license' => {'id' => $p->{'LICENSE'} } };
    }
  }
  my $purlurl = gen_purl($p, $distro, $pkgtype);
  $cyc->{'purl'} = $purlurl if $purlurl;
  if (!$p->{'cyc_id'}) {
    $p->{'cyc_id'} = "pkg:$p->{'NAME'}-" . gen_pkg_id($p);
    $p->{'cyc_id'} =~ s/[^a-zA-Z0-9\.\-]/-/g;
    $p->{'cyc_id'} =~ s/-/:/;
  }
  $cyc->{'bom-ref'} = $p->{'cyc_id'};
  return $cyc;
}

sub cyclonedx_encode_dist {
  my ($dist) = @_;
  my $cyc = {
    'type' => 'operating-system',
    'name' => $dist->{'id'},
  };
  $cyc->{'version'} = $dist->{'version_id'} if defined($dist->{'version_id'}) && $dist->{'version_id'} ne '';
  $cyc->{'description'} = $dist->{'pretty_name'} if $dist->{'pretty_name'};
  push @{$cyc->{'externalReferences'}}, { 'url' => $dist->{'bug_report_url'}, 'type' => 'issue-tracker' } if $dist->{'bug_report_url'};
  push @{$cyc->{'externalReferences'}}, { 'url' => $dist->{'home_url'}, 'type' => 'website' } if $dist->{'home_url'};
  return $cyc;
}

sub cyclonedx_encode_header {
  my ($subjectname) = @_;
  my $cyc = {
    'bomFormat' => 'CycloneDX',
    'specVersion' => '1.4',
    'version' => 1,
    'metadata' => {
      'timestamp' => rfc3339time(time()),
      'tools' => [ {'name' => $tool_name, 'version' => $tool_version } ],
    },
  };
  return $cyc;
}

##################################################################################################
#
# SPDX support
#

my $spdx_json_template = {
  '_order' => [ qw{spdxVersion dataLicense SPDXID name documentNamespace creationInfo packages files relationships} ],
  'creationInfo' => {
    '_order' => [ qw{created creators licenseListVersion} ],
  },
  'packages' => {
    '_order' => [ qw{name SPDXID versionInfo supplier originator downloadLocation sourceInfo homepage licenseConcluded licenseDeclared copyrightText externalRefs} ],
    'externalRefs' => {
      '_order' => [ qw{referenceCategory referenceType referenceLocator} ],
    },
  },
  'files' => {
    '_order' => [ qw{fileName SPDXID checksums licenseConcluded copyrightText comment} ],
  },
  'relationships' => {
    '_order' => [ qw{spdxElementId relatedSpdxElement relationshipType} ],
  },
};

sub spdx_encode_pkg {
  my ($p, $distro, $pkgtype) = @_;
  my $vr = $p->{'VERSION'};
  $vr = "$vr-$p->{'RELEASE'}" if defined $p->{'RELEASE'};
  my $evr = $vr;
  $evr = "$p->{'EPOCH'}:$evr" if $p->{'EPOCH'};
  my $spdx = {
    'name' => $p->{'NAME'},
    'versionInfo' => $evr,
  };
  if ($p->{'VENDOR'}) {
    $spdx->{'originator'} = "Organization: $p->{'VENDOR'}";
    $spdx->{'supplier'} = $spdx->{'originator'}; # same as originator OBS-247
  }
  $spdx->{'downloadLocation'} = 'NOASSERTION';
  if ($pkgtype eq 'deb') {
    $spdx->{'sourceInfo'} = 'acquired package info from DPKG DB';
  } else {
    $spdx->{'sourceInfo'} = 'acquired package info from RPM DB';
  }
  $spdx->{'licenseConcluded'} = 'NOASSERTION';
  $spdx->{'licenseDeclared'} = 'NOASSERTION';
  my $license = $p->{'LICENSE'};
  if ($license) {
    $license =~ s/ and / AND /g;
    $spdx->{'licenseConcluded'} = $license;
    $spdx->{'licenseDeclared'} = $license unless ($config->{'buildflags:spdx-declared-license'} || '') eq 'NOASSERTION';
  }
  $spdx->{'copyrightText'} = 'NOASSERTION';
  $spdx->{'copyrightText'} = $p->{'COPYRIGHTTEXT'} if $p->{'COPYRIGHTTEXT'};
  $spdx->{'homepage'} = $p->{'URL'} if $p->{'URL'};
  my $purlurl = gen_purl($p, $distro, $pkgtype);
  push @{$spdx->{'externalRefs'}}, { 'referenceCategory' => 'PACKAGE-MANAGER', 'referenceType' => 'purl', 'referenceLocator', $purlurl } if $purlurl;
  if (!$p->{'spdx_id'}) {
    $p->{'spdx_id'} = "SPDXRef-Package-$p->{'NAME'}-" . gen_pkg_id($p);
    $p->{'spdx_id'} =~ s/[^a-zA-Z0-9\.\-]/-/g;
  }
  $spdx->{'SPDXID'} = $p->{'spdx_id'};
  return $spdx;
}

sub spdx_encode_file {
  my ($f) = @_;
  my $spdx = {
    'fileName' => $f->{'name'},
    'licenseConcluded' => 'NOASSERTION',
    'copyrightText' => '',
  };
  my @chks;
  push @chks, { 'algorithm' => 'SHA256', 'checksumValue' => $f->{'sha256sum'} } if $f->{'sha256sum'};
  $spdx->{'checksums'} = \@chks if @chks;
  $f->{'spdx_id'} = "SPDXRef-".Digest::MD5::md5_hex($f->{'name'}.($f->{'sha256sum'} || ''));
  $spdx->{'SPDXID'} = $f->{'spdx_id'};
  return $spdx;
}

sub spdx_encode_header {
  my ($subjectname) = @_;
  my $spdx = {
    'spdxVersion' => 'SPDX-2.3',
    'dataLicense' => 'CC0-1.0',
    'SPDXID' => 'SPDXRef-DOCUMENT',
    'name' => $subjectname,
  };
  my $creationinfo = {
    'created' => rfc3339time(time()),
    'creators' => [ "Tool: $tool_name-$tool_version" ],
    'licenseListVersion' => '3.19',
  };
  $spdx->{'creationInfo'} = $creationinfo;
  return $spdx;
}

##################################################################################################


my $wrap_intoto;
my $isproduct;
my $isdir;
my $istar;
my $distro;
my $rpmmd;
my $format;
my $dist_opt;
my $arch;
my $configdir = ($::ENV{'BUILD_DIR'} || '/usr/lib/build') . '/configs';

while (@ARGV && $ARGV[0] =~ /^-/) {
  my $opt = shift @ARGV;
  if ($opt eq '--distro') {
    $distro = shift @ARGV;
  } elsif ($opt eq '--intoto') {
    $wrap_intoto = 1;
  } elsif ($opt eq '--product') {
    $isproduct = 1;
  } elsif ($opt eq '--dir') {
    $isdir = 1;
  } elsif ($opt eq '--rpmmd') {
    $rpmmd = 1;
  } elsif ($opt eq '--container-archive') {
    $istar = 1;
  } elsif ($opt eq '--format') {
    $format = shift @ARGV;
  } elsif ($opt eq '--help') {
    echo_help();
    exit(0);
  } elsif ($opt eq '--dist') {
    $dist_opt = shift @ARGV;
  } elsif ($opt eq '--arch' || $opt eq '--archpath') {
    $arch = shift @ARGV;
  } elsif ($opt eq '--configdir') {
    $configdir = shift @ARGV;
  } else {
    last if $opt eq '--';
    die("unknown option: $opt\n");
  }
}

$format ||= 'spdx';
die("unknown format $format\n") unless $format eq 'spdx' || $format eq 'cyclonedx';

sub echo_help {
    print "\n
The Software Bill of Materials (SBOM) generation tool
=====================================================

This tool generates SBOM data based on data from rpm and deb packages.

Output formats
==============

  --format spdx
     Generates SPDX 2.3 formated data. This is the default.

  --format cyclonedx
     Generates CycloneDX 1.4 formated data

  --intoto
     Can be used optional to wrap the generated data into in-toto.io
     specified format.

Supported content
=================

  --dir DIRECTORY
     The RPM/Dpkg database of the system below DIRECTORY will be evaluated, also all
     files will be referenced in the SBOM if RPM is used.

  --product DIRECTORY
     An installation medium. All .rpm files in any sub directory will be scanned.

  --rpmmd DIRECTORY
     A directory providing rpm-md meta data. A 'repodata/repomd.xml' file is expected.

  --container-archive CONTAINER_ARCHIVE
     An container providing a system

";
}
die("usage: generate_sbom [--distro NAME] [--format spdx|cyclonedx] [--intoto] [--dir DIRECTORY]|[--product DIRECTORY]|[--rpmmd DIRECTORY]|[--container-archive CONTAINER_ARCHIVE]\n") unless @ARGV == 1;
my $toprocess = $ARGV[0];

my $tmpdir = File::Temp::tempdir( CLEANUP => 1 );

my $files;
my $pkgs;
my $dist;
my $pkgtype = 'rpm';

$config = Build::read_config_dist($dist_opt, $arch || 'noarch', $configdir) if $dist_opt;
my $no_files_generation = ($config->{'buildflags:spdx-files-generation'} || '') eq 'no';

if ($isproduct) {
  # product case
  #$files = gen_filelist($toprocess);
  $pkgs = read_pkgs_from_product_directory($toprocess);
} elsif ($rpmmd) {
  require Build::Rpmmd;
  my $primary;
  if (-d $toprocess) {
    $toprocess = "$toprocess/repodata" unless -f "$toprocess/repomd.xml";
    my %d = map {$_->{'type'} => $_} @{Build::Rpmmd::parse_repomd("$toprocess/repomd.xml")};
    my $primary = $d{'primary'};
    die("no primary type in repomd.xml\n") unless $primary;
    my $loc = $primary->{'location'};
    $loc =~ s/.*\///;
    $toprocess .= "/$loc";
  }
  die("$toprocess: $!\n") unless -e $toprocess;
  $pkgs = read_pkgs_from_rpmmd($toprocess);
} elsif ($isdir) {
  $dist = read_dist($toprocess);
  $pkgtype = pkgtype_from_dist($dist);
  #if it is a ubuntu id_like contains debian
  if ($pkgtype eq 'deb') {
    $pkgs = read_pkgs_deb($toprocess);
  } elsif ($pkgtype eq 'rpm') {
    dump_rpmdb($toprocess, "$tmpdir/rpmdb");
    $pkgs = read_pkgs_rpmdb("$tmpdir/rpmdb");
  }
  $files = gen_filelist($toprocess) if $format eq 'spdx' && !$no_files_generation;
} else { # no check for $istar to stay backward compatible
  # container tar case
  my $unpackdir = unpack_container($tmpdir, $toprocess);
  $dist = read_dist($unpackdir);
  $pkgtype = pkgtype_from_dist($dist);
  if ($pkgtype eq 'deb') {
    $pkgs = read_pkgs_deb($unpackdir);
  } elsif ($pkgtype eq 'rpm') {
    dump_rpmdb($unpackdir, "$tmpdir/rpmdb");
    $pkgs = read_pkgs_rpmdb("$tmpdir/rpmdb");
  }
  $files = gen_filelist($unpackdir) if $format eq 'spdx' && !$no_files_generation;
}

my $subjectname = $toprocess;
$subjectname =~ s/.*\///;

if (!$distro && $dist) {
  $distro = $dist->{'id'};
  $distro .= "-$dist->{'version_id'}" if defined($dist->{'version_id'}) && $dist->{'version_id'} ne '';
  $distro .= "-$dist->{'build_id'}" if defined($dist->{'build_id'}) && $dist->{'build_id'} ne '';
}

my $json_template;
my $intoto_type;
my $doc;

if ($format eq 'spdx') {
  $json_template = $spdx_json_template;
  $intoto_type = 'https://spdx.dev/Document';
  $doc = spdx_encode_header($subjectname);
  for my $p (@$pkgs) {
    push @{$doc->{'packages'}}, spdx_encode_pkg($p, $distro, $pkgtype);
  }
  for my $f (@$files) {
    next if $f->{'SKIP'};
    push @{$doc->{'files'}}, spdx_encode_file($f);
  }

  if (@$files) {
    my %f2p;
    for my $p (@$pkgs) {
      push @{$f2p{$_}}, $p for @{$p->{'FILENAMES'} || []};
    }
    for my $f (@$files) {
      next if $f->{'SKIP'};
      #warn("unpackaged file: $f->{'name'}\n") unless @{$f2p{$f->{'name'}} || []};
      for my $p (@{$f2p{$f->{'name'}} || []}) {
	next unless $f->{'spdx_id'} && $p->{'spdx_id'};
	my $rel = {
	  'spdxElementId' => $p->{'spdx_id'},
	  'relatedSpdxElement' => $f->{'spdx_id'},
	  'relationshipType', 'CONTAINS',
	};
	push @{$doc->{'relationships'}}, $rel;
      }
    }
  }
  push @{$doc->{'relationships'}}, {
    'spdxElementId' => 'SPDXRef-DOCUMENT',
    'relatedSpdxElement' => 'SPDXRef-DOCUMENT',
    'relationshipType', 'DESCRIBES',
  };
  $doc->{'documentNamespace'} = 'http://open-build-service.org/spdx/'.urlencode($subjectname).'-'.gen_uuid($doc);
} elsif ($format eq 'cyclonedx') {
  $json_template = $cyclonedx_json_template;
  $intoto_type = 'https://cyclonedx.org/bom';
  $doc = cyclonedx_encode_header($subjectname);
  for my $p (@$pkgs) {
    push @{$doc->{'components'}}, cyclonedx_encode_pkg($p, $distro, $pkgtype);
  }
  if ($dist && %$dist) {
    push @{$doc->{'components'}}, cyclonedx_encode_dist($dist);
  }
  $doc->{'serialNumber'} = 'urn:uuid:'.gen_uuid($doc);
} else {
  die("internal error\n");
}

if ($wrap_intoto) {
  my $subject = { 'name' => $subjectname };
  # no digest for products as it might be a directory. And an iso file would change the checksum later while signing.
  $subject->{'digest'} = { 'sha256' => sha256file($toprocess) } unless $isproduct || $isdir;
  $doc = {
    '_type' => 'https://in-toto.io/Statement/v0.1',
    'subject' => [ $subject ],
    'predicateType' => $intoto_type,
    'predicate' => $doc,
  };
  $json_template = {
    '_order' => [ qw{_type predicateType subject predicate} ],
    'subject' => { '_order' => [ qw{name digest} ] },
    'predicate' => $json_template,
  };
}

print Build::SimpleJSON::unparse($doc, 'template' => $json_template, 'keepspecial' => 1)."\n";