#! /usr/bin/perl

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# package Tmp version 1.0
#
# Create temporary files/directories and ensures they are removed at
# program end.
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
{
  package Tmp;

  use File::Temp;
  use strict 'vars';
  use Cwd 'abs_path';

  sub new
  {
    my $self = {};
    my $save_tmp = shift;

    bless $self;

    my $x = $0;
    $x =~ s#.*/##;
    $x =~ s/(\s+|"|\\|')/_/;
    $x = 'tmp' if$x eq "";

    my $t = File::Temp::tempdir(abs_path("/tmp") . "/$x.XXXXXXXX", CLEANUP => $save_tmp ? 0 : 1);

    $self->{base} = $t;

    if(!$save_tmp) {
      my $s_t = $SIG{TERM};
      $SIG{TERM} = sub { File::Temp::cleanup; &$s_t if $s_t };

      my $s_i = $SIG{INT};
      $SIG{INT} = sub { File::Temp::cleanup; &$s_i if $s_i };
    }

    return $self
  }

  sub dir
  {
    my $self = shift;
    my $dir = shift;
    my $t;

    if($dir ne "" && !-e("$self->{base}/$dir")) {
      $t = "$self->{base}/$dir";
      die "error: mktemp failed\n" unless mkdir $t, 0755;
    }
    else {
      chomp ($t = `mktemp -d $self->{base}/XXXX`);
      die "error: mktemp failed\n" if $?;
    }

    return $t;
  }

  sub file
  {
    my $self = shift;
    my $file = shift;
    my $t;

    if($file ne "" && !-e("$self->{base}/$file")) {
      $t = "$self->{base}/$file";
      open my $f, ">$t";
      close $f;
    }
    else {
      chomp ($t = `mktemp $self->{base}/XXXX`);
      die "error: mktemp failed\n" if $?;
    }

    return $t;
  }

  # helper function
  sub umount
  {
    my $mp = shift;

    if(open(my $f, "/proc/mounts")) {
      while(<$f>) {
        if((split)[1] eq $mp) {
          # print STDERR "umount $mp\n";
          ::susystem("umount $mp");
          return;
        }
      }
      close $f;
    }
  }

  sub mnt
  {
    my $self = shift;
    my $dir = shift;

    my $t = $self->dir($dir);

    if($t ne '') {
      eval 'END { local $?; umount $t }';

      my $s_t = $SIG{TERM};
      $SIG{TERM} = sub { umount $t; &$s_t if $s_t };

      my $s_i = $SIG{INT};
      $SIG{INT} = sub { umount $t; &$s_i if $s_i };
    }

    return $t;
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
use strict;
use utf8;

use Getopt::Long;
use Digest::MD5;
use Digest::SHA;
use File::Path 'make_path';
use Cwd 'abs_path';
use JSON;

use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 1;
$Data::Dumper::Deepcopy = 1;

binmode(STDOUT, ":utf8");
binmode(STDERR, ":utf8");

our $VERSION = "0.0";
our $LIBEXECDIR = "/usr/lib";

use constant {
  # offset of application specific data (anything goes)
  ISO9660_APP_DATA_START => 0x8373,

  # application specific data length
  ISO9660_APP_DATA_LENGTH => 0x200,

  # signature block starts with this string
  SIGNATURE_MAGIC => "7984fc91-a43f-4e45-bf27-6d3aa08b24cf"
};

sub usage;
sub show;
sub show_and_exit;
sub show_conditional;

sub chk_joliet;
sub ckh_rockridge;
sub chk_files_permission;
sub chk_files_owner;
sub chk_file_exists;
sub chk_treeinfo_arch;
sub chk_treeinfo_files;
sub chk_bootinfo;
sub chk_garbage;
sub chk_signature;
sub chk_hybrid_chrp;
sub chk_hybrid_efi;
sub chk_eltorito;

sub susystem;
sub get_iso9660_info;
sub iso_ls;
sub read_ini;
sub get_media_style;
sub get_media_variant;
sub get_arch;
sub get_expected_media_layout;
sub get_expected_suse_media_layout;
sub get_expected_rh_media_layout;
sub stat_file;
sub is_dir;
sub is_file;
sub read_data;
sub read_file;
sub extract_file;
sub get_grub_root;
sub file_magic;
sub fs_type;
sub get_archive_type;
sub unpack_cpiox;
sub unpack_archive;
sub unpack_initrd;
sub get_root_option_initrd;
sub get_root_option_bootloader;
sub parse_tag;
sub get_tag;
sub set_tag;
sub read_tags;

my $opt_save_temp;
my $opt_verbose = 0;
my $opt_ignore;
my $opt_ignore_list = [
  "UEFI boot image exists",
  "ISO digest is sha256 or better",
  "boot partition type is EFI System Partition"
];
my $opt_ignore_list_extra_rh = [
  "ISO data partition has non-zero offset",
  "ISO is ready to be signed",
  "ISO is signed"
];

my $tmp;
my $media;
my $iso9660;
my $errors = 0;
my $error_detail;
my $src;
my $src_short;
my $iso_ls_rockridge;
my $iso_ls_plain;
my $iso_dir;
my $initrd_dir;

Getopt::Long::Configure("gnu_compat");

GetOptions(
  'ignore=s'         => \@$opt_ignore_list,
  'save-temp'        => \$opt_save_temp,
  'verbose|v'        => sub { $opt_verbose++ },
  'version'          => sub { print "$VERSION\n"; exit 0 },
  'help'             => sub { usage 0 },
) || usage 1;

$ENV{PATH} = "$LIBEXECDIR/mkmedia:/usr/bin:/bin:/usr/sbin:/sbin";

$tmp = Tmp::new($opt_save_temp);

usage 1 unless @ARGV == 1;

$opt_ignore->{$_} = 1 for @$opt_ignore_list;

$src = shift;

die "$src: no such file\n" unless -f $src;
die "$src: not readable\n" unless -r _;

($src_short = $src) =~ s#^.*/##;
print "Verifying: $src_short\n";
print "Check results: [✔] = ok, [✘] = bad, [!] = not ideal\n";

$iso_dir = $tmp->dir('iso');

$iso9660 = get_iso9660_info $src;
print "- iso header info:\n", Dumper($iso9660) if $opt_verbose >= 2;

show_and_exit
  defined($iso9660),
  "image has ISO-9660 file system",
  "Image must be using an ISO-9660 file system.";

show
  chk_rockridge($iso9660),
  "image uses Rock Ridge extension",
  "ISO image must use Rock Ridge extension ('mkisofs -R', default in xorriso).";

show
  chk_joliet($iso9660),
  "image uses Joliet extension",
  "ISO image must use Joliet extension ('mkisofs -J', 'xorriso -joliet on').";

show
  $iso9660->{volume_id} ne "",
  "image has volume id",
  "ISO image must have a non-empty volume id.";

$iso_ls_plain = iso_ls $src;
$iso_ls_rockridge = iso_ls $src, "rockridge";
print "- iso file list (rock ridge):\n", Dumper($iso_ls_rockridge) if $opt_verbose >= 2;

show
  chk_files_permission($iso_ls_rockridge),
  "all files are world-readable",
  "Files on the ISO image should be readable by all users (chmod o+r).";

show
  chk_files_owner($iso_ls_rockridge),
  "all files are owned by root",
  "Files on the ISO image should have uid and gid 0.";

$media->{treeinfo} = read_ini ".treeinfo";
print "- .treeinfo:\n", Dumper($media->{treeinfo}) if $media->{treeinfo} && $opt_verbose >= 2;

$media->{style} = get_media_style;
$media->{variant} = get_media_variant;
$media->{arch} = get_arch;
get_expected_media_layout $media;

$media->{tags} = read_tags;

print "- media:\n", Dumper($media) if $opt_verbose >= 2;
die "failed to detect architecture\n" unless $media->{arch};

if($media->{style} eq 'rh') {
  $opt_ignore->{$_} = 1 for @$opt_ignore_list_extra_rh;
}

show
  $media->{style} ne "",
  "media style: $media->{style}",
  "Could not determine media style.";

show
  $media->{variant} ne "",
  "media variant: $media->{variant}",
  "Could not determine media variant.";

show
  $media->{arch} ne "",
  "media architecture: $media->{arch}",
  "Could not determine media architecture.";

show_and_exit
  $media->{kernel} ne "",
  "media layout supported",
  "This media layout is not supported by verifymedia.";

show_conditional
  $media->{treeinfo},
  chk_treeinfo_arch($media),
  ".treeinfo architecture matches",
  "'arch' entry in 'general' section in .treeinfo must match media architecture.";

show_conditional
  $media->{treeinfo},
  chk_treeinfo_files($media),
  "kernel and initrd referenced in .treeinfo exist",
  "Kernel and initrd referenced in .treeinfo must exist.";

show
  chk_file_exists($media->{kernel}),
  "kernel exists",
  "Kernel must exist and have non-zero size.";

show
  chk_file_exists($media->{initrd}),
  "initrd exists",
  "Initrd must exist and have non-zero size.";

show_conditional
  $media->{initrd_off},
  chk_file_exists($media->{initrd_off}),
  "initrd.off exists",
  "'initrd.off' must exist and have non-zero size.";

show_conditional
  $media->{initrd_siz},
  chk_file_exists($media->{initrd_siz}),
  "initrd.siz exists",
  "'initrd.siz' must exist and have non-zero size.";

show_conditional
  $media->{initrd_addrsize},
  chk_file_exists($media->{initrd_addrsize}),
  "initrd.addrsize exists",
  "'initrd.addrsize' must exist and have non-zero size.";

show_conditional
  $media->{cd_ikr},
  chk_file_exists($media->{cd_ikr}),
  "boot image exists",
  "'$media->{cd_ikr}' must exist and have non-zero size.";

show_conditional
  $media->{suse_ins},
  chk_file_exists($media->{suse_ins}),
  "ins file exists",
  "'$media->{suse_ins}' must exist and have non-zero size.";

show_conditional
  $media->{isolinux_cfg},
  chk_file_exists($media->{isolinux_cfg}),
  "isolinux config exists",
  "isolinux.cfg must exist and have non-zero size.";

show_conditional
  $media->{bootinfo_txt},
  chk_file_exists($media->{bootinfo_txt}),
  "bootinfo config exists",
  "bootinfo.txt must exist and have non-zero size.";

show_conditional
  $media->{bootinfo_txt},
  chk_bootinfo($media),
  "bootinfo config points to grub",
  "boot-script entry in bootinfo.txt must point to grub and\ngrub must have a config file in the same location.";

show_conditional
  $media->{grub_earlyboot_cfg},
  chk_file_exists($media->{grub_earlyboot_cfg}),
  "early grub config exists",
  "Early grub config must exist and have non-zero size.";

$media->{grub_earlyboot_cfg_root} = get_grub_root $media->{grub_earlyboot_cfg};

show_conditional
  $media->{grub_earlyboot_cfg_root},
  chk_file_exists($media->{grub_earlyboot_cfg_root}),
  "grub early config references correct root file system",
  "'$media->{grub_earlyboot_cfg}' searches for '$media->{grub_earlyboot_cfg_root}' to identify its root file system.\nThis file must exist.";

show_conditional
  $media->{grub_cfg},
  chk_file_exists($media->{grub_cfg}),
  "grub config exists",
  "grub.cfg must exist and have non-zero size.";

$media->{grub_cfg_root} = get_grub_root $media->{grub_cfg};

show_conditional
  $media->{grub_cfg_root},
  chk_file_exists($media->{grub_cfg_root}),
  "grub config references correct root file system",
  "'$media->{grub_cfg}' searches for '$media->{grub_cfg_root}' to identify its root file system.\nThis file must exist.";

show_conditional
  $media->{efi_grub_cfg},
  chk_file_exists($media->{efi_grub_cfg}),
  "UEFI grub config exists",
  "UEFI grub.cfg must exist and have non-zero size.";

$media->{efi_grub_cfg_root} = get_grub_root $media->{efi_grub_cfg};

show_conditional
  $media->{efi_grub_cfg_root},
  chk_file_exists($media->{efi_grub_cfg_root}),
  "UEFI grub config references correct root file system",
  "'$media->{efi_grub_cfg}' searches for '$media->{efi_grub_cfg_root}' to identify its root file system.\nThis file must exist.";

show_conditional
  $media->{efi_loader},
  chk_file_exists($media->{efi_loader}),
  "UEFI boot loader exists",
  "UEFI boot loader must exist and have non-zero size.";

show_conditional
  $media->{efi_image},
  chk_file_exists($media->{efi_image}),
  "UEFI boot image exists",
  "UEFI boot image should exist in file system and have non-zero size.";

$media->{root_option} = get_root_option_bootloader $media;

if(!$media->{root_option} && $media->{variant} eq 'live') {
  $initrd_dir = unpack_initrd $media->{initrd};
  $media->{root_option} = get_root_option_initrd $initrd_dir;
}

print "- root option: $media->{root_option}\n" if $media->{root_option} && $opt_verbose >= 1;

show_conditional
  $media->{variant} eq 'live',
  $media->{root_option} =~ /^live:(?:CD)?LABEL=(.*)/ && $1 eq $iso9660->{volume_id},
  "ISO label matches dracut live root option",
  "ISO label '$iso9660->{volume_id}' must correspond to dracut live root option '$media->{root_option}'.";

show_conditional
  $media->{variant} eq 'selfinstall',
  $media->{root_option} =~ /^install:(?:CD)?LABEL=(.*)/ && $1 eq $iso9660->{volume_id},
  "ISO label matches KIWI install root option",
  "ISO label '$iso9660->{volume_id}' must correspond to KIWI install root option '$media->{root_option}'.";

show
  chk_garbage($media),
  "no garbage files",
  "These files are not needed and should be removed.";

my $parti = `parti --json $src`;
$media->{parti} = decode_json($parti) if $parti;

print "- partition data:\n", Dumper($media->{parti}) if $media->{parti} && $opt_verbose >= 2;

my $hybrid;

my $has_partitions;

if($media->{hybrid_mode}) {
  $hybrid = chk_hybrid_chrp($media) if $media->{hybrid_mode} eq 'chrp';
  $hybrid = chk_hybrid_efi($media) if $media->{hybrid_mode} eq 'efi';

  print "- hybrid data:\n", Dumper($hybrid) if $hybrid && $opt_verbose >= 2;

  if($media->{hybrid_mode} eq 'efi') {
    $has_partitions = $hybrid && !$hybrid->{apple} && ($hybrid->{mbr} || $hybrid->{gpt});

    show
      $has_partitions,
      "has MBR or GPT partition table",
      "To be bootable as disk image, there must be an MBR or GPT partition table.";

    if($has_partitions) {
      show
        $hybrid && $hybrid->{efi_partition},
        "has boot partition with VFAT file system",
        "To be UEFI bootable as disk, there must be a VFAT boot partition.";

      show_conditional
        $hybrid && $hybrid->{efi_partition},
        $hybrid && $hybrid->{efi_partition_is_esp},
        "boot partition type is EFI System Partition",
        "The boot partition type should be EFI System Partition.";

      if($hybrid && $hybrid->{efi_partition}) {
        my $stat = stat_file $media->{efi_image};

        show_conditional
          $stat,
          $stat && $stat->{start} * 4 == $hybrid->{efi_partition_start} && $stat->{size} == $hybrid->{efi_partition_size} * 512,
          "boot partition refers to UEFI boot image file",
          "There is a UEFI boot image file but it is not used as UEFI boot partition.";
      }

      show
        $hybrid && $hybrid->{data_partition},
        "has data partition pointing to ISO image",
        "There must be a data partition pointing to the same file system you get\nwhen acessing the entire ISO image." .
        ($iso9660->{volume_id} eq "" ? "\nThe data partition must have a non-empty volume id" : "");

      show
        $hybrid && !$hybrid->{data_partition_at_0},
        "ISO data partition has non-zero offset",
        "ISO data partition should not start at block 0 as this breaks partitioning tools.";

      show
        $hybrid && !$hybrid->{invalid_partition},
        "no invalid partition entries",
        "All partition table entries must have either valid data or be completely empty.";
    }
  }

  if($media->{hybrid_mode} eq 'chrp') {
    show
      $hybrid && $hybrid->{mbr} && !$hybrid->{gpt},
      "has MBR partition table",
      "To be bootable as disk image, there must be an MBR partition table.\nA GPT does not work.";

    show
      $hybrid && !$hybrid->{apple},
      "has no Apple partition table",
      "In the past we had (in addition to MBR) an Apple partition table; this is not\nneeded anymore (no PPC Macs) and leads to problems.";

    show
      $hybrid && $hybrid->{chrp_partition},
      "has CHRP partition starting at block 0",
      "To be bootable, the 1st partition must have type 0x96 and start at block 0.";

    show
      $hybrid && !$hybrid->{invalid_partition},
      "no invalid partition entries",
      "Other partition table entries must have valid data or be completely empty.";
  }
}

my $eltorito = chk_eltorito($media);
print "- el torito data:\n", Dumper($eltorito) if $eltorito && $opt_verbose >= 2;

show_conditional
  $media->{eltorito_legacy},
  $eltorito->{legacy},
  "El Torito x86 legacy bootable",
  "ISO boot catalog must have an El Torito entry for x86 legacy boot (pointing to grub or isolinux).";

show_conditional
  $media->{eltorito_efi},
  $eltorito->{efi},
  "El Torito UEFI bootable",
  "ISO boot catalog must have El Torito entry for an EFI System Partition image.";

show_conditional
  $media->{eltorito_efi} && $hybrid && $hybrid->{efi_partition} && $has_partitions,
  $hybrid && $eltorito->{efi_start} == $hybrid->{efi_partition_start} && $eltorito->{efi_size} == $hybrid->{efi_partition_size},
  "El Torito UEFI entry points to boot partition",
  "El Torito UEFI image should be the same as the UEFI boot partition.";

show_conditional
  $media->{eltorito_s390x},
  $eltorito->{s390x},
  "El Torito S390X bootable",
  "ISO boot catalog must have El Torito entry for an S390X IKR image.";

my $sig = chk_signature $media;
$media->{signature} = $sig if $sig;

print "- signature data:\n", Dumper($media->{signature}) if $media->{signature} && $opt_verbose >= 2;

show
  $sig->{block_digest},
  "ISO has digest",
  "There must be a digest stored in media tag data. Ideally sha256 or sha512.\n(check settings with 'tagmedia --show').";

if($sig->{block_digest}) {
  my $digest_ok = $sig->{block_digest} =~ /sha(256|384|512)/;
  $error_detail = "Digest is $sig->{block_digest}." if ! $digest_ok;
  show
    $digest_ok,
    "ISO digest is sha256 or better",
    "Prefer a secure digest like sha256, sha384, or sha512.\n(check settings with 'tagmedia --show').";
}

show_conditional
  $media->{expect_signature_file},
  $sig->{file_ok},
  "has .signature file",
  "
    There should be a '.signature' file to hold the signature.
    The file (if it exists) must have a size of 2048 bytes and
    start with the string '${\SIGNATURE_MAGIC}'.
  ";

show_conditional
  $media->{expect_signature_file} && $sig->{file_ok},
  $sig->{block_is_file},
  "signature block and .signature file are identical",
  "If there is a '.signature' file, the 'signature' tag must point to it.";

show
  $sig->{block_ok},
  "ISO is ready to be signed",
  "To be able to sign media, there must be a 'signature' entry in media tag data\npointing to a signature block (check settings with 'tagmedia --show').";

show
  $sig->{block_signed},
  "ISO is signed",
  "ISO must be signed.";

print "- $errors error(s)\n" if $opt_verbose >= 1;


exit($errors ? 1 : 0);


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# usage(exit_code)
#
# Print help text and exit with exit_code.
#
sub usage
{
  print <<"= = = = = = = =";
Usage: verifymedia ISO
Verify SUSE installation media.

      --ignore TOPIC              Ignore specific test results. The test is still run but any failures
                                  are not counted. The option can be repeated to exclude several tests.
      --verbose                   Increase log level.
      --version                   Show verifymedia version.
      --save-temp                 Keep temporary files.
      --help                      Write this help text.

Program exit code is 0 if no errors were found and != 0 in case of errors.

More information is available in the verifymedia(1) manual page.
= = = = = = = =

  exit shift;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub show
{
  my $result = $_[0];
  my $topic = $_[1];
  my $comment = $_[2];

  $result = $result ? 1 : $opt_ignore->{$topic} ? 2 : 0;

  $errors++ if $result == 0;

  # values: bad, ok, not nice
  my @mark = ( "\x{2718}", "\x{2714}", "!" );

  die "show(): oops, result $result out of range" if $result >= @mark;

  my $indent = "";
  my $indent_c = "  ";

  printf "${indent}[%-1s] %s\n", $mark[$result], $topic;

  if($result == 0 || $result == 2) {
    $comment =~ s/\s+$//g;
    $comment =~ s/^\s*/$indent_c/;
    $comment =~ s/\n\s*/\n$indent_c/g;

    if($error_detail ne "") {
      $error_detail =~ s/\s+$//g;
      $error_detail =~ s/^\s*/$indent_c/;
      $error_detail =~ s/\n\s*/\n$indent_c/g;
      print "$error_detail\n";
    }

    print "$comment\n";
  }

  undef $error_detail;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub show_and_exit
{
  my $errors_old = $errors;

  show @_;

  exit 1 if $errors > $errors_old;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub show_conditional
{
  return unless $_[0];

  shift;

  show @_;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_joliet
{
  my $iso_header = $_[0];

  return $iso_header->{joliet} ? 1 : 0;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_rockridge
{
  my $iso_header = $_[0];

  return $iso_header->{rockridge} ? 1 : 0;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_files_permission
{
  my $iso_list = $_[0]->{list};
  my $ok = 1;

  for my $file (@$iso_list) {
    if(substr($file->{perm}, 6, 1) ne 'r') {
      $error_detail .= sprintf "%s %3d %3d %10d %s\n", $file->{perm}, $file->{uid}, $file->{gid}, $file->{size}, $file->{name};
      $ok = 0;
    }
  }

  return $ok;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_files_owner
{
  my $iso_list = $_[0]->{list};
  my $ok = 1;

  for my $file (@$iso_list) {
    if($file->{uid} != 0 || $file->{gid} != 0) {
      $error_detail .= sprintf "%s %3d %3d %10d %s\n", $file->{perm}, $file->{uid}, $file->{gid}, $file->{size}, $file->{name};
      $ok = 0;
    }
  }

  return $ok;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_file_exists
{
  my $file = $_[0];

  my $stat = stat_file $file;

  my $ok = $stat && $stat->{size} > 0 ? 1 : 0;

  $error_detail = $file if !$ok;

  return $ok;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_treeinfo_arch
{
  my $media = $_[0];

  return 0 unless $media->{treeinfo} && $media->{treeinfo}{general};

  return 1 if $media->{arch} eq $media->{treeinfo}{general}{arch};

  $error_detail = "'$media->{treeinfo}{general}{arch}' != '$media->{arch}'";

  return 0;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_treeinfo_files
{
  my $media = $_[0];

  return 0 unless $media->{treeinfo};

  my $missing;

  for my $section (sort keys %{$media->{treeinfo}}) {
    my $t = $media->{treeinfo}{$section};
    for my $file ('initrd', 'kernel') {
      $missing->{$t->{$file}} = 1 if $t->{$file} && !is_file $t->{$file};
    }
  }

  return 1 if !$missing;

  for my $m (sort keys %$missing) {
    $error_detail .= "$m\n";
  }

  return 0;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_bootinfo
{
  my $media = $_[0];

  # use $iso_ls_plain as PowerPC firmware does not understand Rock Ridge extension
  my $iso_by_name = $iso_ls_plain->{by_name};

  return 0 unless $media->{bootinfo_txt} && $iso_by_name->{$media->{bootinfo_txt}};

  my $data = read_file $media->{bootinfo_txt};

  my $grub;

  if($data =~ /:([^:]+)<\/boot-script>/) {
    $grub = $1;
    $grub =~ s/^1,//;
    $grub =~ tr#\\#/#;
    $grub =~ s#^/##;
  }

  if($grub eq "") {
    $error_detail = "$media->{bootinfo_txt}: no <boot-script> element found";
    return 0;
  }

  if(!$iso_by_name->{$grub}) {
    $error_detail = "$media->{bootinfo_txt}: boot-script $grub does not exists";
    return 0;
  }

  my $cfg = $grub;
  $cfg =~ s#[^/]*$#grub.cfg#;

  if($media->{grub_earlyboot_cfg}) {
    if($cfg ne $media->{grub_cfg} && $cfg ne $media->{grub_earlyboot_cfg} ) {
      $error_detail = "expecting grub config $cfg for $grub";
      return 0;
    }
  }

  return 1;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_garbage
{
  my $media = $_[0];

  undef $error_detail;

  for my $f (sort keys %{$media->{garbage_files}}) {
    $error_detail .= "$f\n" if stat_file $f;
  }

  return $error_detail ? 0 : 1;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_signature
{
  my $media = $_[0];

  my $sig;

  $sig->{block_digest} = 'md5' if get_tag($media->{tags}, 'md5sum') || get_tag($media->{tags}, 'iso md5sum');
  $sig->{block_digest} = 'sha256' if get_tag $media->{tags}, 'sha256sum';
  $sig->{block_digest} = 'sha384' if get_tag $media->{tags}, 'sha384sum';
  $sig->{block_digest} = 'sha512' if get_tag $media->{tags}, 'sha512sum';

  my $sig_block = get_tag $media->{tags}, 'signature';
  if($sig_block) {
    $sig->{block_start} = $sig_block->{value} * 512;
    $sig->{block_size} = 2048;
    $sig->{block_data} = read_data $sig->{block_start}, $sig->{block_size};
    $sig->{block_ok} = 1 if substr($sig->{block_data}, 0, length(SIGNATURE_MAGIC)) eq SIGNATURE_MAGIC;
    $sig->{block_signed} = 1 if $sig->{block_data} =~ /PGP SIGNATURE/;
  }

  my $sig_file = stat_file ".signature";
  if($sig_file) {
    $sig->{file_start} = $sig_file->{start} * 2048;
    $sig->{file_size} = $sig_file->{size};
    $sig->{file_data} = read_file '.signature';
    $sig->{file_ok} = 1 if $sig->{file_size} == 2048 && substr($sig->{file_data}, 0, length(SIGNATURE_MAGIC)) eq SIGNATURE_MAGIC;
  }

  $sig->{block_is_file} = 1 if $sig->{file_start} && $sig->{block_start} && $sig->{block_start} == $sig->{file_start};

  return $sig;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_hybrid_chrp
{
  my $media = $_[0];
  my $hybrid;

  my $parti = $media->{parti};

  return unless $parti;

  $hybrid->{apple} = 1 if $parti->{apple};
  $hybrid->{gpt} = 1 if $parti->{gpt};

  if($parti->{mbr}) {
    $hybrid->{mbr} = 1;
    for my $p (@{$parti->{mbr}{partitions}}) {
      $hybrid->{invalid_partition} = 1, next if !$p->{attributes}{valid};
      $hybrid->{chrp_partition} = 1 if $p->{index} == 0 && $p->{first_lba} == 0 && $p->{type_id} eq 0x96;
    }
  }

  return $hybrid;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_hybrid_efi
{
  my $media = $_[0];
  my $hybrid;

  my $parti = $media->{parti};

  return unless $parti;

  my $uuid = $parti->{filesystem}{uuid} if $parti->{filesystem};
  my $label = $parti->{filesystem}{label} if $parti->{filesystem};

  $hybrid->{apple} = 1 if $parti->{apple};

  my $partitions;

  if($parti->{gpt_primary}) {
    $hybrid->{gpt} = 1;
    $partitions = $parti->{gpt_primary}{partitions};
  }
  elsif($parti->{mbr}) {
    $hybrid->{mbr} = 1;
    $partitions = $parti->{mbr}{partitions};
  }

  if($partitions) {
    for my $p (@$partitions) {
      $hybrid->{invalid_partition} = 1, next if $hybrid->{mbr} && !$p->{attributes}{valid};
      if($p->{first_lba} != 0 && $p->{filesystem} && $p->{filesystem}{type} eq 'vfat') {
        $hybrid->{efi_partition} = 1;
        $hybrid->{efi_partition_start} = $p->{first_lba};
        $hybrid->{efi_partition_size} = $p->{size};
        $hybrid->{efi_partition_is_esp} = 1 if $p->{type_name} eq "efi" || $p->{type_name} eq "efi system";
      }
      if(
        $p->{filesystem} &&
        $p->{filesystem}{type} eq 'iso9660' && (
          ($p->{filesystem}{uuid} && $p->{filesystem}{uuid} eq $uuid) ||
          ($p->{filesystem}{label} && $p->{filesystem}{label} eq $label)
        )
      ) {
        $hybrid->{data_partition} = 1;
        $hybrid->{data_partition_at_0} = 1 if $p->{first_lba} == 0;
      }
    }
  }

  return $hybrid;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub chk_eltorito
{
  my $media = $_[0];
  my $eltorito;

  my $parti = $media->{parti};

  return unless $parti;

  if($parti->{eltorito}) {
    for my $c (@{$parti->{eltorito}{catalog}}) {
      next if $c->{media_type} ne 'no emulation';
      $eltorito->{legacy} = 1, next if $c->{boot_info_table};
      if($c->{filesystem} && $c->{filesystem}{type} eq 'vfat') {
        $eltorito->{efi} = 1;
        $eltorito->{efi_start} = $c->{first_lba};
        $eltorito->{efi_size} = $c->{size};
        next;
      }
      $eltorito->{s390x} = 1 if $c->{s390x_parm} || $c->{file_name} =~ /\.ikr$/;
    }
  }

  return $eltorito;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_iso9660_info
{
  my $iso = $_[0];
  my $info = `isoinfo -d -i $iso 2>/dev/null`;
  my $data = {};

  return unless $info =~ /CD-ROM is in ISO 9660 format/;

  $data->{system_id} = $1 if $info =~ /^System id: (.*)/m;
  $data->{volume_id} = $1 if $info =~ /^Volume id: (.*)/m;
  $data->{publisher_id} = $1 if $info =~ /^Publisher id: (.*)/m;
  $data->{application_id} = $1 if $info =~ /^Application id: (.*)/m;
  $data->{preparer_id} = $1 if $info =~ /^Data preparer id: (.*)/m;
  $data->{joliet} = 1 if $info =~ /^Joliet .* found/m;
  $data->{rockridge} = 1 if $info =~ /^Rock Ridge .* found/m;
  $data->{eltorito} = $1 if $info =~ /^El Torito .* found, boot catalog is in sector (\d+)/m;

  print "- iso header info:\n", Dumper($iso9660) if $opt_verbose >= 2;

  return $data;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# ISO file list sorted by start address.
#
# Return ref to hash with files.
#
sub iso_ls
{
  my $iso = $_[0];
  my $extension = $_[1];
  my $files;

  if($extension eq "joliet") {
    $extension = "-J";
  }
  elsif($extension eq "rockridge") {
    $extension = "-R";
  }
  else {
    $extension = "";
  }

  open my $fd, "isoinfo $extension -l -i $iso 2>/dev/null |";

  my $dir = "/";

  while(<$fd>) {
    if(/^Directory listing of\s*(\/.*\/)/) {
      $dir = $1;
      next;
    }

    # isoinfo format change
    # cf. https://sourceforge.net/p/cdrtools/mailman/message/35173024
    s/^\s*\d+\s+//;

    if(/^(.)(.*)\s\[\s*(\d+)(\s+\d+)?\]\s+(.*?)\s*$/) {
      my $type = $1;
      my @x = split ' ', $2;
      $type = ' ' if $type eq '-';
      if($5 ne '.' && $5 ne '..') {
        my $start = $3 + 0;
        my $name = "$dir$5";
        $name =~ s#^/##;
        $name =~ s/\.?\;1$// if !$extension;
        push @$files, { name => $name, type => $type, start => $start, perm => $x[0], uid => $x[2], gid => $x[3], size => $x[4] };
      }
    }
  }

  close $fd;

  my $by_name;

  if($files) {
    $files = [ sort { $a->{start} <=> $b->{start} } @$files ];

    for my $n (@$files) {
      $by_name->{$n->{name}} = $n;
    }
  }

  return { list => $files, by_name => $by_name };
}


# -------------------------------------------------------------------------------------------------
# -------------------------------------------------------------------------------------------------
# -------------------------------------------------------------------------------------------------



# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# get_media_style(sources)
#
# - sources: array_ref containing a list of directories
#
# Look at sources and determine media style (suse vs. rh).
#
# Assume rh style if there's an '/isolinux' dir or a '.discinfo' file or
# there are '<FOO>/Packages' subdirectories.
#
# FIXME: Ferdora Live is reported as 'suse'.
#
sub get_media_style
{
  return 'rh' if is_file(".discinfo") || is_file("Fedora-Legal-README.txt");

  for my $dir ("isolinux", "Packages", "BaseOS/Packages", "AppStream/Packages") {
    return 'rh' if is_dir $dir;
  }

  return 'suse';
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# get_media_variant(sources)
#
# - sources: array_ref containing a list of directories
#
# Look at sources and determine media variant (install vs. live).
#
# Assume a Live medium if there's an '/LiveOS' dir.
#
sub get_media_variant
{
  return 'live' if is_dir "LiveOS";
  return 'selfinstall' if is_file "config.isoclient";

  return 'install';
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# read_ini(file)
#
# - file: file name
#
# Read ini-style config file.
#
# Return content as hash reference.
#
sub read_ini
{
  my $file = $_[0];
  my $ini;
  my $section;

  my $data = read_file $file;

  for (split /\n/, $data) {
    s/\s*;.*//;
    next if /^\s*$/;
    if(/^\s*\[([^]]+)\]/) {
      $section = $1;
      next;
    }
    next if !defined $section;
    if(/^\s*([^=>]+?)\s*+=\s*+(.*?)\s*$/) {
      $ini->{$section}{$1} = $2;
    }
  }

  return $ini;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_arch
{
  my $arch;

  for my $x ('aarch64', 'i386', 'ppc64', 'ppc64le', 's390x', 'x86_64') {
    return $x if is_dir "boot/$x";
  }

  return 'x86_64' if is_file "EFI/BOOT/BOOTX64.EFI";
  return 'x86_64' if is_file "EFI/BOOT/bootx64.efi";

  return 'i386' if is_file "EFI/BOOT/BOOTIA32.EFI";
  return 'i386' if is_file "EFI/BOOT/bootia32.efi";

  return 'aarch64' if is_file "EFI/BOOT/BOOTAA64.EFI";
  return 'aarch64' if is_file "EFI/BOOT/bootaa64.efi";

  return 'ppc64le' if is_file "ppc/bootinfo.txt";

  return 's390x' if is_file "generic.ins";

  return $arch;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Note: uses global var $iso_ls_rockridge.
#
sub get_expected_media_layout
{
  my $media = $_[0];

  # files that should not really be there
  for my $f (qw ( glump ppc/os-chooser )) {
    $media->{garbage_files}{$f} = 1;
  }

  for my $f (keys %{$iso_ls_rockridge->{by_name}}) {
    $media->{garbage_files}{$f} = 1 if $f =~ /(^|\/)TRANS\.TBL$/;
  }

  if($media->{style} eq 'suse') {
    get_expected_suse_media_layout $media;
  }
  elsif($media->{style} eq 'rh') {
    get_expected_rh_media_layout $media;
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_expected_suse_media_layout
{
  my $media = $_[0];

  my $arch = $media->{arch};

  return unless $arch;

  if($media->{variant} eq 'install') {
    if($arch eq 'aarch64') {
      $media->{initrd} = "boot/aarch64/initrd";
      $media->{kernel} = "boot/aarch64/linux";
      $media->{efi_loader} = "EFI/BOOT/bootaa64.efi";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_efi} = 1;
    }
    elsif($arch eq 'i386') {
      $media->{isolinux_cfg} = "boot/i386/loader/isolinux.cfg";
      $media->{el_torito_image} = "boot/i386/loader/isolinux.bin";
      $media->{initrd} = "boot/i386/loader/initrd";
      $media->{kernel} = "boot/i386/loader/linux";
      $media->{efi_image} = "boot/i386/efi";
      $media->{efi_loader} = "EFI/BOOT/bootia32.efi";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_legacy} = 1;
      $media->{eltorito_efi} = 1;
    }
    elsif($arch eq 'ppc64le') {
      $media->{initrd} = "boot/ppc64le/initrd";
      $media->{kernel} = "boot/ppc64le/linux";
      $media->{bootinfo_txt} = "ppc/bootinfo.txt";
      $media->{grub_cfg} = "boot/grub2/grub.cfg";
      $media->{grub_earlyboot_cfg} = "boot/ppc64le/grub2-ieee1275/grub.cfg";
      $media->{hybrid_mode} = 'chrp';
    }
    elsif($arch eq 's390x') {
      $media->{initrd} = "boot/s390x/initrd";
      $media->{initrd_off} = "boot/s390x/initrd.off";
      $media->{initrd_siz} = "boot/s390x/initrd.siz";
      $media->{kernel} = "boot/s390x/linux";
      $media->{cd_ikr} = "boot/s390x/cd.ikr";
      $media->{suse_ins} = "boot/s390x/suse.ins";
      $media->{eltorito_legacy} = 1;
      $media->{eltorito_s390x} = 1;
    }
    elsif($arch eq 'x86_64') {
      $media->{isolinux_cfg} = "boot/x86_64/loader/isolinux.cfg";
      $media->{el_torito_image} = "boot/x86_64/loader/isolinux.bin";
      $media->{initrd} = "boot/x86_64/loader/initrd";
      $media->{kernel} = "boot/x86_64/loader/linux";
      $media->{efi_image} = "boot/x86_64/efi";
      $media->{efi_loader} = "EFI/BOOT/bootx64.efi";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_legacy} = 1;
      $media->{eltorito_efi} = 1;
    }
  }
  elsif($media->{variant} eq 'live') {
    $media->{expect_signature_file} = 1;

    if($arch eq 'aarch64') {
      $media->{grub_cfg} = "boot/grub2/grub.cfg";
      $media->{initrd} = "boot/aarch64/loader/initrd";
      $media->{kernel} = "boot/aarch64/loader/linux";
      $media->{efi_image} = "boot/aarch64/loader/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/bootaa64.efi";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      chomp(my $id = read_file "boot/mbrid");
      $media->{grub_search_id} = "/boot/$id" if is_file "boot/$id";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_efi} = 1;
    }
    elsif($arch eq 'ppc64le') {
      $media->{initrd} = "boot/ppc64le/initrd";
      $media->{kernel} = "boot/ppc64le/linux";
      $media->{bootinfo_txt} = "ppc/bootinfo.txt";
      $media->{grub_cfg} = "boot/grub2/grub.cfg";
      $media->{grub_earlyboot_cfg} = "boot/grub2/powerpc-ieee1275/grub.cfg";
      $media->{hybrid_mode} = 'chrp';
    }
    elsif($arch eq 's390x') {
      $media->{initrd} = "boot/s390x/initrd";
      $media->{initrd_off} = "boot/s390x/initrd.off";
      $media->{initrd_siz} = "boot/s390x/initrd.siz";
      $media->{kernel} = "boot/s390x/linux";
      $media->{cd_ikr} = "boot/s390x/cd.ikr";
      $media->{suse_ins} = "boot/s390x/suse.ins";
      $media->{eltorito_s390x} = 1;
    }
    elsif($arch eq 'x86_64') {
      $media->{grub_cfg} = "boot/grub2/grub.cfg";
      $media->{grub_earlyboot_cfg} = "boot/grub2/earlyboot.cfg";
      $media->{el_torito_image} = "boot/x86_64/loader/eltorito.img";
      $media->{initrd} = "boot/x86_64/loader/initrd";
      $media->{kernel} = "boot/x86_64/loader/linux";
      $media->{efi_image} = "boot/x86_64/loader/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/bootx64.efi";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      chomp(my $id = read_file "boot/mbrid");
      $media->{grub_search_id} = "/boot/$id" if is_file "boot/$id";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_legacy} = 1;
      $media->{eltorito_efi} = 1;
    }
  }
  elsif($media->{variant} eq 'selfinstall') {
    $media->{expect_signature_file} = 1;

    if($arch eq 'aarch64') {
      $media->{grub_cfg} = "boot/grub2/grub.cfg";
      $media->{initrd} = "boot/aarch64/loader/initrd";
      $media->{kernel} = "boot/aarch64/loader/linux";
      $media->{efi_image} = "boot/aarch64/loader/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/bootaa64.efi";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      chomp(my $id = read_file "boot/mbrid");
      $media->{grub_search_id} = "/boot/$id" if is_file "boot/$id";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_efi} = 1;
    }
    elsif($arch eq 'ppc64le') {
      $media->{initrd} = "boot/ppc64le/loader/initrd";
      $media->{kernel} = "boot/ppc64le/loader/linux";
      $media->{bootinfo_txt} = "ppc/bootinfo.txt";
      $media->{grub_cfg} = "boot/grub2/grub.cfg";
      $media->{grub_earlyboot_cfg} = "boot/grub2/powerpc-ieee1275/grub.cfg";
      $media->{hybrid_mode} = 'chrp';
    }
    elsif($arch eq 's390x') {
      $media->{initrd} = "boot/s390x/initrd";
      $media->{initrd_off} = "boot/s390x/initrd.off";
      $media->{initrd_siz} = "boot/s390x/initrd.siz";
      $media->{kernel} = "boot/s390x/linux";
      $media->{cd_ikr} = "boot/s390x/cd.ikr";
      $media->{suse_ins} = "boot/s390x/suse.ins";
      $media->{eltorito_s390x} = 1;
    }
    elsif($arch eq 'x86_64') {
      $media->{grub_cfg} = "boot/grub2/grub.cfg";
      $media->{grub_earlyboot_cfg} = "boot/grub2/earlyboot.cfg";
      $media->{el_torito_image} = "boot/x86_64/loader/eltorito.img";
      $media->{initrd} = "boot/x86_64/loader/initrd";
      $media->{kernel} = "boot/x86_64/loader/linux";
      $media->{efi_image} = "boot/x86_64/loader/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/bootx64.efi";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      chomp(my $id = read_file "boot/mbrid");
      $media->{grub_search_id} = "/boot/$id" if is_file "boot/$id";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_legacy} = 1;
      $media->{eltorito_efi} = 1;
    }
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_expected_rh_media_layout
{
  my $media = $_[0];

  my $arch = $media->{arch};

  return unless $arch;

  if($media->{variant} eq 'install') {
    if($arch eq 'aarch64') {
      $media->{initrd} = "images/pxeboot/initrd.img";
      $media->{kernel} = "images/pxeboot/vmlinuz";
      $media->{efi_image} = "images/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/BOOTAA64.EFI";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_efi} = 1;
    }
    elsif($arch eq 'i386') {
      $media->{el_torito_image} = "images/eltorito.img";
      $media->{initrd} = "images/pxeboot/initrd.img";
      $media->{kernel} = "images/pxeboot/vmlinuz";
      $media->{efi_image} = "images/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/BOOTIA32.EFI";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_legacy} = 1;
      $media->{eltorito_efi} = 1;
    }
    elsif($arch eq 'ppc64le') {
      $media->{initrd} = "ppc/ppc64/initrd.img";
      $media->{kernel} = "ppc/ppc64/vmlinuz";
      $media->{bootinfo_txt} = "ppc/bootinfo.txt";
      $media->{grub_cfg} = "boot/grub/grub.cfg";
      $media->{hybrid_mode} = 'chrp';
    }
    elsif($arch eq 's390x') {
      $media->{initrd} = "images/initrd.img";
      $media->{initrd_addrsize} = "images/initrd.addrsize";
      $media->{kernel} = "images/kernel.img";
      $media->{cd_ikr} = "images/cdboot.img";
      $media->{suse_ins} = "generic.ins";
      $media->{eltorito_s390x} = 1;
    }
    elsif($arch eq 'x86_64') {
      $media->{el_torito_image} = "images/eltorito.img";
      $media->{initrd} = "images/pxeboot/initrd.img";
      $media->{kernel} = "images/pxeboot/vmlinuz";
      $media->{efi_image} = "images/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/BOOTX64.EFI";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_legacy} = 1;
      $media->{eltorito_efi} = 1;
    }
  }
  elsif($media->{variant} eq 'live') {
    $media->{expect_signature_file} = 1;

    if($arch eq 'aarch64') {
      $media->{initrd} = "images/pxeboot/initrd.img";
      $media->{kernel} = "images/pxeboot/vmlinuz";
      $media->{efi_image} = "images/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/BOOTAA64.EFI";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_efi} = 1;
    }
    elsif($arch eq 'ppc64le') {
      $media->{initrd} = "ppc/ppc64/initrd.img";
      $media->{kernel} = "ppc/ppc64/vmlinuz";
      $media->{bootinfo_txt} = "ppc/bootinfo.txt";
      $media->{grub_cfg} = "boot/grub/grub.cfg";
      $media->{hybrid_mode} = 'chrp';
    }
    elsif($arch eq 's390x') {
      $media->{initrd} = "images/initrd.img";
      $media->{initrd_addrsize} = "images/initrd.addrsize";
      $media->{kernel} = "images/kernel.img";
      $media->{cd_ikr} = "images/cdboot.img";
      $media->{suse_ins} = "generic.ins";
      $media->{eltorito_s390x} = 1;
    }
    elsif($arch eq 'x86_64') {
      $media->{grub_cfg} = "boot/grub2/grub.cfg";
      $media->{el_torito_image} = "images/eltorito.img";
      $media->{initrd} = "images/pxeboot/initrd.img";
      $media->{kernel} = "images/pxeboot/vmlinuz";
      $media->{efi_image} = "images/efiboot.img";
      $media->{efi_loader} = "EFI/BOOT/BOOTX64.EFI";
      $media->{efi_grub_cfg} = "EFI/BOOT/grub.cfg";
      $media->{hybrid_mode} = 'efi';
      $media->{eltorito_legacy} = 1;
      $media->{eltorito_efi} = 1;
    }
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Note: uses global var $iso_ls_rockridge.
#
sub stat_file
{
  my $file = $_[0];

  return undef if !defined $file;

  my $stat = $iso_ls_rockridge->{by_name}{$file};

  return $stat;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub is_dir
{
  my $file = $_[0];

  my $stat = stat_file $file;

  return $stat && $stat->{type} eq 'd';
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub is_file
{
  my $file = $_[0];

  my $stat = stat_file $file;

  return $stat && $stat->{type} eq ' ';
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Note: uses global var $src.
#
sub read_data
{
  my $start = $_[0];
  my $size = $_[1];

  my $data;

  if(open my $fd, $src) {
    sysseek($fd, $start, 0) or die "$src: seek to $start failed\n";
    if($size) {
      sysread($fd, $data, $size) == $size or die "$src: reading $size bytes failed\n";
    }
    else {
      $data = "";
    }
    close $fd;
  }

  return $data;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub read_file
{
  my $file = $_[0];

  my $stat = stat_file $file;

  return undef if !defined($stat) || $stat->{type} ne " ";

  return read_data $stat->{start} * 2048, $stat->{size};
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Note: uses global var $iso_dir.
#
sub extract_file
{
  my $file = $_[0];

  my $stat = stat_file $file;

  return undef if !defined($stat) || $stat->{type} ne " ";

  return 1 if $stat->{extracted};

  my $dir = $file;
  $dir =~ s#[^/]+$##;

  make_path "$iso_dir/$dir" if $dir ne "";

  my $ok;

  if(-d "$iso_dir/$dir") {
    my $data = read_file $file;
    if(defined $data) {
      if(open my $fd, ">", "$iso_dir/$file") {
        $ok = syswrite($fd, $data) == length($data);
        close $fd;
      }
    }
  }

  $stat->{extracted} = 1 if $ok;

  die "$file: extracting failed\n" unless $ok;

  return 1;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_grub_root
{
  my $file = $_[0];

  my $data = read_file $file;

  my $root;

  if($data) {
    # search --file --set=root /boot/0x11cebed2
    # search --no-floppy --file /boot/aarch64/efi --set
    if($data =~ /^search .*--set=root \/(\S+)/m) {
      $root = $1;
    }
    elsif($data =~ /^search .*--file \/(\S+) .*--set/m) {
      $root = $1;
    }
  }

  return $root;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Run 'file' system command.
#
# result = file_magic(file, pipe)
#
# -   file: the input file, or '-' if pipe is set
# -   pipe: (if set) the command to read from
# - result: everything 'file' returns
#
sub file_magic
{
  my $type = "file -b -k -L $_[0] 2>/dev/null";
  $type = "$_[1] | $type" if $_[1];

  return `$type`;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# result = fs_type(file, pipe, offset)
#
# -   file: the input file, or '-' if pipe is set
# -   pipe: (if set) the command to read from
# - offset: probe at offset
# - result: type hash
#
sub fs_type
{
  my $file = $_[0];
  my $pipe = $_[1];
  my $offset = $_[2] || 0;
  my $type = { };

  if($pipe) {
    if(open my $fd, "$pipe |") {
      my $buf;
      # 1 MiB seems to be the minimum for blkid to work
      my $i = read $fd, $buf, 1024*1024;
      close $fd;
      $file = $tmp->file();
      if(open my $fd, ">", $file) {
        syswrite $fd, $buf;
        close $fd;
      }
      else {
        undef $file;
      }
    }
  }

  if($file) {
    my $blkid = `blkid --offset '$offset' -p '$file' 2>/dev/null`;
    if($blkid =~ /\bUSAGE="filesystem"/ && $blkid =~ /\bTYPE="([^"]*)"/) {
      $type->{fs} = $1;
    }

    if($blkid =~ /\bUSAGE="crypto"/ && $blkid =~ /\bTYPE="([^"]*)"/) {
      $type->{crypto} = $1;
    }

    my $parti = `parti --json $file 2>/dev/null`;
    $parti = decode_json($parti) if $parti;

    if($parti->{gpt_primary}) {
      $type->{gpt} = $parti->{gpt_primary};
    }
    elsif($parti->{mbr}) {
      $type->{mbr} = $parti->{mbr};
    }
    $type->{eltorito} = $parti->{eltorito} if $parti->{eltorito};
  }

  return $type;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Get archive type;
#
# type = get_archive_type(file)
#
# - file: the archive name
# - type: something like 'tar.xz' or undef if the archive is unsupported.
#
# The special type '[start:length]' designates a part of the file of 'length' bytes
# beginning at 'start'. A 'length' of 0 means 'to the end of file'.
#
# type can ba a comma-separated list of individual types. Which makes only sense in
# relation to types containing '[start:length]' to indicate that different parts of
# a file can have different archive types.
#
sub get_archive_type
{
  my $file = $_[0];
  my $type;
  my $cmd;

  my $orig = $file;

  if(-d $file) {
    return 'dir';
  }

  if(! (-f $file || -b _)) {
    return undef;
  }

  if(! -r $file) {
    die "$orig: not readable; you need root privileges.\n";
  }

  my @types_found;

  do {
    my $t = file_magic $file, $cmd;

    if($t =~ /^RPM/) {
      $type = "cpio.rpm$type";
    }
    elsif($t =~ /^ASCII cpio archive \(SVR4/) {
      $type = "cpiox$type";
      if(!$cmd) {
        my $cpiox_stats = unpack_cpiox undef, $file;
        my $len = $cpiox_stats ? $cpiox_stats->{bytes} : 0;
        if($len < -s $file) {
          push @types_found, "$type.[0:$len]";
          $type = ".[$len:]";
          $cmd = "dd status=none bs=$len skip=1 if='$file' 2>/dev/null";
          $file = "-";
        }
      }
    }
    elsif($t =~ /\b(cpio|tar|rar) archive/i) {
      $type = "\L$1\E$type";
    }
    elsif($t =~ / QCOW /) {
      $type = "qcow$type";
    }
    elsif($t =~ /Zip archive data|Zip data|EPUB /) {
      $type = "zip$type";
    }
    elsif($t =~ /^(bzip2|gzip|XZ|Zstandard) compressed data/) {
      my $c = "\L$1";
      $c =~ s/zstandard/zstd/;
      if($cmd) {
        $cmd .= " | $c --quiet -dc";
      }
      else {
        $cmd = "$c --quiet -dc '$file'";
      }
      $file = "-";
      $c =~ s/bzip2/bz2/;
      $c =~ s/gzip/gz/;
      $c =~ s/zstd/zst/;
      $type = ".$c$type";
    }
    else {
      my $type_added = 0;
      my $fs_type = fs_type $file, $cmd;
      my $saved_type = $type;

      if($fs_type->{fs}) {
        $type = "fs_$fs_type->{fs}$saved_type";
        $type_added = 1;
      }

      if($fs_type->{crypto}) {
        $type = "$fs_type->{crypto}$saved_type";
        $type_added = 1;
      }

      if($saved_type !~ /,/) {
        if($fs_type->{gpt}) {
          for my $p (@{$fs_type->{gpt}{partitions}}) {
            if($p->{size}) {
              my $start = $p->{first_lba} * $fs_type->{gpt}{block_size};
              my $size = $p->{size} * $fs_type->{gpt}{block_size};
              my $fs_type2 = fs_type $file, $cmd, $start;
              my $fs2 = "fs_$fs_type2->{fs}" if $fs_type2->{fs};
              $fs2 ||= $fs_type2->{crypto};
              $fs2 .= "." if $fs2 ne "";
              $type .= ",${fs2}part$p->{number}.[$start:$size]$saved_type";
              $type_added = 1;
            }
          }
        }
        if($fs_type->{mbr}) {
          for my $p (@{$fs_type->{mbr}{partitions}}) {
            if($p->{size}) {
              my $start = $p->{first_lba} * $fs_type->{mbr}{block_size};
              my $size = $p->{size} * $fs_type->{mbr}{block_size};
              my $fs_type2 = fs_type $file, $cmd, $start;
              my $fs2 = "fs_$fs_type2->{fs}" if $fs_type2->{fs};
              $fs2 ||= $fs_type2->{crypto};
              $fs2 .= "." if $fs2 ne "";
              $type .= ",${fs2}part$p->{number}.[$start:$size]$saved_type";
              $type_added = 1;
            }
          }
        }
        if($fs_type->{eltorito}) {
          my $number = 1;
          for my $p (@{$fs_type->{eltorito}{catalog}}) {
            if($p->{size}) {
              my $start = $p->{first_lba} * $fs_type->{mbr}{block_size};
              my $size = $p->{size} * $fs_type->{mbr}{block_size};
              my $fs_type2 = fs_type $file, $cmd, $start;
              my $fs2 = "fs_$fs_type2->{fs}" if $fs_type2->{fs};
              $fs2 ||= $fs_type2->{crypto};
              $fs2 .= "." if $fs2 ne "";
              $type .= ",${fs2}eltorito$number.[$start:$size]$saved_type";
              $type_added = 1;
            }
            $number++ if $p->{boot};
          }
        }
      }

      $type =~ s/^,?//;

      return undef if !$type_added;
    }
  } while($type =~ /^\./);

  push @types_found, $type;
  $type = join ",", @types_found;

  # print "$file = $type\n";

  return $type;
}


# Unpack multiple concatenated cpio archives.
#
# The archives are expected to be in cpio ASCII format ('cpio -H newc').
# Between the idividual archives an arbitrary sequence of (binary) zeros is
# allowed. (This is what the kernel allows for the initramfs image.)
#
# unpack_cpiox(dst, file, part)
#
# -  dst: the directory to unpack to; if dst is undef, don't unpack anything (just parse)
# - file: the archive file name
# - part: the part number (1 based) of a multipart archive (0 = unpack all)
#
# If dst is undef, write nothing.
#
# Return hash with two elements:
#   - bytes = size of cpiox archive (data actually read)
#   - parts = number of individual cpiox archives parsed
#
# If 'part' is != 0, 'bytes' is the end of that part (right after the 'TRAILER!!!' entry).
# If 'part' is 0, 'bytes' is the end of valid cpiox data + any trailing 0 bytes.
#
sub unpack_cpiox
{
  my $dst = shift;
  my $file = shift;
  my $part = shift() + 0;

  my $cpio_cmd = 'cpio --quiet -dmiu --sparse --no-absolute-filenames 2>/dev/null';

  # the archive number we are looking for (1 based)
  my $cnt = 1;

  # input and output file handles
  my ($f, $p);

  # data transfer buffer
  my $buf;

  # search for cpio header in input stream on next read operation
  my $sync = 0;

  # track # of written bytes (reset at start of each cpio archive)
  my $write_ofs;

  # track # of read bytes
  my $read_ofs;

  # Read # of bytes from input and write to output.
  #
  # bytes = $read_write->(len)
  # -   len: number of bytes to transfer
  # - bytes: size of data actually transferred
  #
  # This function implicitly opens a new output pipe if none is open and data
  # need to be written.
  #
  # If the $sync variable is set search the input stream for a valid cpio
  # header (and reset $sync to 0).
  #
  my $read_write = sub
  {
    my $len = $_[0];

    # nothing to do
    return $len if !$len;

    # clear buffer
    undef $buf;

    # Search for next cpio header.
    #
    # This assumes there's a number of binary zeros in the input stream
    # until the next cpio header.
    # Actually this only looks for the next non-zero data blob.
    if($sync) {
      $sync = 0;
      while(sysread($f, $buf, 1) == 1 && $buf eq "\x00") { $read_ofs++ };
      $read_ofs += length $buf;
      $len -= length $buf;
    }

    # read $len bytes
    while($len) {
      my $x = sysread $f, substr($buf, length $buf), $len;
      last if !$x;
      $read_ofs += $x;
      $len -= $x;
    };

    # In case we did read something, write it to output pipe.
    if(length $buf) {
      # Open a new pipe if needed.
      # But only if part number matches or is 0 (== all parts).
      if($dst && !$p && ($part == 0 || $part == $cnt)) {
        open $p, "| ( cd $dst ; $cpio_cmd )" or die "failed to open cpio: $!\n";
        $write_ofs = 0;
      }

      # Write data and track output size for padding calculation at the end.
      if($p) {
        syswrite $p, $buf;
        $write_ofs += length $buf;
      }
    }

    return length $buf;
  };

  # Write padding bytes (pad with 0 to full 512 byte blocks) and close
  # output pipe.
  #
  # $write_pad_and_close->()
  #
  # This also sets a sync flag indicating that we should search for the next
  # valid cpio header in the input stream.
  #
  my $write_pad_and_close = sub
  {
    if($p) {
      my $pad = (($write_ofs + 0x1ff) & ~0x1ff) - $write_ofs;
      syswrite $p, "\x00" x $pad, $pad if $pad;
      close $p;
      undef $p;
    }

    # search for next cpio header in input stream
    $sync = 1;
  };

  # open archive and get going...
  if(open $f, $file) {
    my $len;

    # We have to trace the cpio archive structure.
    # Keep going as long as there's a header.
    while(($len = $read_write->(110)) == 110) {
      my $magic = substr($buf, 0, 6);
      my $head = substr($buf, 6);

      if($magic !~ /^07070[12]$/) {
        close $f;
        return { bytes => $read_ofs - $len, parts => $cnt - 1 } if !$dst;
        die "broken cpio header\n";
      }

      my $fname_len = hex substr $buf, 94, 8;
      my $data_len = hex substr $buf, 54, 8;

      $fname_len += (2, 1, 0, 3)[$fname_len & 3];
      $data_len = (($data_len + 3) & ~3);

      $read_write->($fname_len);

      my $fname = $buf;
      $fname =~ s/\x00*$//;

      $read_write->($data_len);

      # Look for cpio archive end marker.
      # If found, close cpio process. A new process will be started at the
      # next valid cpio archive header.
      if(
        $fname eq 'TRAILER!!!' &&
        $head =~ /^0{39}10{55}b0{8}$/i
      ) {
        $write_pad_and_close->();
        # exit if we're done
        if($cnt++ == $part) {
          close $f;
          return { bytes => $read_ofs, parts => $part };
        }
      }
    }

    # we're done, close input file...
    close $f;

    # ...and output file.
    $write_pad_and_close->();

    # If $len is != 0 this means we've seen something that's not a header of
    # a cpio archive entry.
    die "invalid cpio data\n" if $len;
  }
  else {
    die "error reading cpio archive: $!\n";
  }

  return { bytes => $read_ofs, parts => $cnt - 1 };
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Unpack archive file.
#
# unpack_archive(type, file, dir, part)
#
# - type: a type string as returned by get_archive_type
# - file: the archive
# -  dir: the directory to unpack to
# - part: is the part number of a multipart archive (0 = unpack all)
#
# Sample type strings:
#
#   "dir", "tar", "tar.gz", "tar.gz.xz", "cpiox.[0:1024],cpiox.xz.gz.[1024:]"
#
# Type string is a comma-separated list of individual sub_types.
#
sub unpack_archive
{
  my $type = $_[0];
  my $file = $_[1];
  my $dir = $_[2];
  my $part = $_[3];

  $type =~ s/,.*$// if $type =~ /^fs_/;

  for my $sub_type (split /,/, $type) {
    next if $sub_type eq '';

    my $cmd;
    my $cpiox;

    if($sub_type eq 'dir') {
      $cmd = "tar -C '$file' -cf - .";
      $sub_type = 'tar';
    }
    elsif(! -r $file) {
      die "$file: not readable; you need root privileges.\n";
    }

    for (reverse split /\./, $sub_type) {
      if(/^(bz2|gz|xz|zst|rpm)$/) {
        my $c;
        if($1 eq 'gz') {
          $c = 'gzip --quiet -dc';
        }
        elsif($1 eq 'xz') {
          $c = 'xz --quiet -dc';
        }
        elsif($1 eq 'zst') {
          $c = 'zstd --quiet --force -dc';
        }
        elsif($1 eq 'bz2') {
          $c = 'bzip2 --quiet -dc';
        }
        else {
          $c = 'rpm2cpio';
        }
        if($cmd) {
          $cmd .= " | $c";
        }
        else {
          $cmd = "$c '$file'";
        }
      }
      elsif(/\[(.*):(.*)\]/) {
        my $start = ($1 ne "" ? $1 : 0) + 0;
        my $len = ($2 ne "" ? $2 : 0) + 0;
        my $args;
        $args = sprintf "bs=1 skip=%d count=%d", $start, $len;
        $args = "bs=$start skip=1" if $start && !$len;
        $args = "bs=$len count=1" if !$start && $len;
        if($cmd) {
          $cmd .= " | dd status=none $args 2>/dev/null";
        }
        else {
          $cmd = "dd status=none $args if='$file' 2>/dev/null";
        }
      }
      elsif($_ eq 'tar') {
        $cmd = "cat '$file'" if !$cmd;
        $cmd .= " | tar -C '$dir' --keep-directory-symlink -xpf - 2>/dev/null";
        last;
      }
      elsif($_ eq 'zip') {
        if(!$cmd) {
          $cmd = "unzip -qX '$file' -d '$dir'";
        }
        else {
          my $t = $tmp->file();
          $cmd .=  " > '$t' ; unzip -qX '$t' -d '$dir'";
        }
        last;
      }
      elsif($_ eq 'rar') {
        my $abs_file = abs_path $file;
        if(!$cmd) {
          $cmd = "cd '$dir' ; unrar x -idq '$abs_file'";
        }
        else {
          my $t = $tmp->file();
          $cmd .=  " > '$t' ; cd '$dir' ; unrar x -idq '$t'";
        }
        last;
      }
      elsif($_ eq '7z') {
        my $abs_file = abs_path $file;
        if(!$cmd) {
          $cmd = "cd '$dir' ; 7z x '$abs_file' > /dev/null";
        }
        else {
          my $t = $tmp->file();
          $cmd .=  " > '$t' ; cd '$dir' ; 7z x '$t' > /dev/null";
        }
        last;
      }
      elsif($_ eq 'fs_iso9660') {
        my $abs_file = abs_path $file;
        if(!$cmd) {
          $cmd = "cd '$dir' ; isoinfo -R -X -j UTF-8 -i '$abs_file' ; chmod --quiet -R u+w .";
        }
        else {
          my $t = $tmp->file();
          $cmd .=  " > '$t' ; cd '$dir' ; isoinfo -R -X -j UTF-8 -i '$t' ; chmod --quiet -R u+w .";
        }
        last;
      }
      elsif($_ eq 'cpio') {
        $cmd = "cat '$file'" if !$cmd;
        $cmd .= " | ( cd '$dir' ; cpio --quiet -dmiu --sparse --no-absolute-filenames 2>/dev/null )";
        last;
      }
      elsif($_ eq 'cpiox') {
        if(!$cmd) {
          $cmd = $file;
        }
        else {
          $cmd .= " |";
        }
        $cpiox = 1;
        last;
      }
      else {
        die "error: cannot handle '$_': command so far: \"$cmd\"\n";
      }
    }

    # cpiox = concatenated compressed cpio archives as the kernel uses for initrd
    # must be SVR4 ASCII format, with or without CRC ('cpio -H newc')
    # in this case we have to parse the cpio stream and handle the 'TRAILER!!!' entries
    if($cpiox) {
      print "unpack_cpiox($cmd)\n" if $opt_verbose >= 2;
      my $cpiox_stats = unpack_cpiox $dir, $cmd, $part;
      if($cpiox_stats && $part) {
        $part -= $cpiox_stats->{parts};
        $part = -1 if !$part;		# 0 has special meaning
      }
    }
    elsif($cmd ne "") {
      print "$cmd\n" if $opt_verbose >= 2;
      system $cmd;
    }
    else {
      die "${\(abs_path $file)}: cannot unpack archive ($type)\n";
    }
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub unpack_initrd
{
  my $file = $_[0];

  return undef unless is_file $file;

  extract_file $file;

  my $tmp_dir = $tmp->dir('initrd');

  my $type = get_archive_type "$iso_dir/$file";

  if($type) {
    unpack_archive $type, "$iso_dir/$file", $tmp_dir;
  }
  else {
    die "$iso_dir: initrd unpacking failed\n";
  }

  return $tmp_dir;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_root_option_initrd
{
  my $initrd = $_[0];

  return undef unless $initrd;

  return undef unless -d "$initrd/etc/cmdline.d";

  my $config = `cat $initrd/etc/cmdline.d/*.conf`;

  return $1 if $config =~ /^root=(\S+)/m;

  return undef;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub get_root_option_bootloader
{
  my $media = $_[0];

  my $grub_cfg = read_file($media->{grub_cfg}) || read_file($media->{efi_grub_cfg});

  return $1 if $grub_cfg =~ /^\s*\$?linux(?:efi)? .* root=(\S+)/m;

  return undef;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# tag = parse_tag(string)
#
# Parse line ('key=value' format) and return hash ref with key/value elements.
# value is undef if there's no '='.
#
sub parse_tag
{
  my ($line) = @_;

  $line =~ s/^\s*|\s*$//g;

  if($line =~ /^([A-Z_\d\s]+?)\s*=\s*+(.*)$/i) {
    return { key => $1, value => $2 };
  }
  else {
    return { key => $line };
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# tag = get_tag(tags, key)
#
# Get tag from tag array with specified key.
# Returns undef if no tag with such a key exists.
#
# tags: array ref with tag hashes
# key: string
# tag: tag hash ref ('key', 'value' pair)
#
sub get_tag
{
  my ($tags, $key) = @_;

  for my $tag (@$tags) {
    return $tag if $tag->{key} eq $key;
  }

  # try again, case insensitive
  for my $tag (@$tags) {
    return $tag if "\L$tag->{key}" eq "\L$key";
  }

  return undef;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# set_tag(tags, tag)
#
# Set tag in tags array.
#
# tags: array ref with tag hashes
# tag: tag hash ref ('key', 'value' pair)
#
sub set_tag
{
  my ($tags, $tag) = @_;

  my $old_tag = get_tag $tags, $tag->{key};
  if($old_tag) {
    $old_tag->{value} = $tag->{value};
  }
  else {
    push @$tags, $tag;
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# tags = read_tags
#
# Read existing tags from image fragment.
#
# image: hash with image related data
# image->{blob}: buffer containing a sufficiently large portion of the image (36 kiB)
# tags: array ref with tags
# tags are hashes with key/value pairs - value is undef if there's no '='
#
sub read_tags
{
  my $data = read_data ISO9660_APP_DATA_START, ISO9660_APP_DATA_LENGTH;

  die "unsupported tag format\n" unless $data  =~ /^[0-9A-Za-z_=,;! \x00]{512}$/;
  $data =~ s/[\s\x00]*$//;

  my $tags = [];

  for my $line (split /;/, $data) {
    set_tag $tags, parse_tag($line);
  }

  return $tags;
}
