#! /usr/bin/perl

# Add/remove key=value pairs from iso application area (0x200 bytes starting
# at 0x8373). Entries are separated by semicolons (';').
#
# Digest is calculated assuming
#   - all zeros in 0x0000-0x01ff (MBR) (only suse style) and
#   - all spaces in 0x8373-0x8572 (ISO9660, application specific data block)
#
# If a signature block is embedded, the signature block is replaced with an
# empty signature block while calculating the digest.
#
use strict;

use Getopt::Long;
use Digest::MD5;
use Digest::SHA;

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

our $VERSION = "0.0";

# Here are some ISO9660 file system related constants.
#
# If in doubt about the ISO9660 layout, check https://wiki.osdev.org/ISO_9660
#
use constant {
  # offset of volume descriptor
  # usually points to "\x01CD001\x01\x00"
  ISO9660_MAGIC_START => 0x8000,

  # offset of volume size (in 2 kiB units)
  # stored as 32 bit little-endian, followed by a 32 bit big-endian value
  ISO9660_VOLUME_SIZE => 0x8050,

  # application identifier length
  ISO9660_APP_ID_LENGTH => 0x80,

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

  # application specific data length
  ISO9660_APP_DATA_LENGTH => 0x200,
};

# Here are some MBR (partition table) related constants.
#
# If in doubt about the MBR layout, check https://wiki.osdev.org/Partition_Table
#
use constant {
  # MBR start
  MBR_OFFSET => 0,

  # offset of MBR magic
  # points to "\x55\xaa"
  MBR_MAGIC_START => 0x1fe,

  # offset of partition table in MBR
  MBR_PARTITION_TABLE => 0x1be,

  # MBR size (in bytes)
  MBR_LENGTH => 0x200,
};

# Some SUSE specific constants.
#
# see
#   https://github.com/openSUSE/mksusecd/blob/master/mksusecd
#   https://github.com/OSInside/kiwi/blob/master/kiwi/iso_tools/iso.py
#
use constant {
  # signature block starts with this string
  SIGNATURE_MAGIC => "7984fc91-a43f-4e45-bf27-6d3aa08b24cf"
};

# Some RH specific constants.
#
# see https://github.com/rhinstaller/isomd5sum
#
use constant {
  # 60 is fixed; $opt_fragments must be a divisor of TOTAL_FRAGMENT_SUM_SIZE
  TOTAL_FRAGMENT_SUM_SIZE => 60,
  # default fragment count
  FRAGMENTS_DEFAULT => 20,
  # the default number of blocks to skip in digest calculation
  SKIP_DEFAULT => 15,
};

sub usage;
sub read_image_blob;
sub get_image_type;
sub get_pad_value;
sub get_skip_value;
sub get_fragments_value;
sub read_tags;
sub write_tags;
sub parse_tag;
sub get_tag;
sub set_tag;
sub remove_tag;
sub prepare_buffer;
sub add_to_digest;
sub calculate_digest;
sub create_signature_block_if_missing;
sub export_tags;
sub export_signature;
sub import_signature;
sub create_signature;
sub normalize_buffer;
sub guess_style;

my $opt_digest = undef;
my $opt_check = 0;
my $opt_supported = 0;
my $opt_pad = undef;
my $opt_skip = undef;
my $opt_fragments = undef;
my $opt_style = undef;
my $opt_show = 1;
my $opt_clean = 0;
my @opt_add_tag;
my @opt_remove_tag;
my $opt_verbose;
my $opt_tags_export;
my $opt_signature_export;
my $opt_signature_import;
my $opt_signature_create;
my $opt_signature_tag;

GetOptions(
  'show'               => \$opt_show,
  'md5|md5sum'         => sub { $opt_digest = 'md5' },
  'digest=s'           => \$opt_digest,
  'style=s'            => sub { die "Unsupported style: $_[1]\n" if $_[1] !~ /^(rh|suse)$/i; $opt_style = "\L$_[1]" },
  'check'              => \$opt_check,
  'supported'          => \$opt_supported,
  'pad=i'              => \$opt_pad,
  'skip=i'             => \$opt_skip,
  'fragments=i'        => sub { die "Unsupported number of fragments: $_[1]\n" if $_[1] < 1 || TOTAL_FRAGMENT_SUM_SIZE % $_[1]; $opt_fragments = $_[1] },
  'add-tag=s'          => \@opt_add_tag,
  'remove-tag=s'       => \@opt_remove_tag,
  'export-tags=s'      => \$opt_tags_export,
  'export-signature=s' => \$opt_signature_export,
  'import-signature=s' => \$opt_signature_import,
  'create-signature=s' => \$opt_signature_create,
  'signature-tag'      => \$opt_signature_tag,
  'no-signature-tag'   => sub { $opt_signature_tag = 0 },
  'clean'              => \$opt_clean,
  'verbose|v'          => sub { $opt_verbose++ },
  'version'            => sub { print "$VERSION\n"; exit 0 },
  'help'               => sub { usage 0 },
) || usage 1;

my $image_data;			# hash ref with image related data
my $current_tags = [];		# current list of tags
my $old_tags = [];		# original list of tags
my $digest_iso;			# digest calculated over iso image
my $digest_part;		# digest calculated over partition

# Note: all '*_block' variables use 0.5 kiB units.

my $fragment_sum_size;
my $signature_key = "signature";

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$image_data->{name} = shift;
if($image_data->{name} eq '') {
  print STDERR "tagmedia: no image specified\n";
  usage 1;
}

$image_data->{write} = $opt_digest || defined $opt_pad || defined $opt_skip || $opt_check ||
  $opt_supported || $opt_clean || @opt_add_tag || @opt_remove_tag;

read_image_blob $image_data;
get_image_type $image_data;

$old_tags = read_tags $image_data;
$opt_style = guess_style $old_tags if !defined $opt_style;

$old_tags = [] if $opt_clean;

# clone tag list
set_tag $current_tags, { key => $_->{key}, value =>  $_->{value} } for @$old_tags;

if($opt_digest =~ /^md5(sum)?$/i) {
  $digest_iso = Digest::MD5->new;
  $digest_part = Digest::MD5->new;
}
elsif($opt_digest =~ /^sha(1|224|256|384|512)(sum)?$/i && $opt_style eq 'suse') {
  $digest_iso = Digest::SHA->new($1);
  $digest_part = Digest::SHA->new($1);
}
elsif($opt_digest) {
  die "$opt_digest: unsupported digest\n";
}

if($opt_digest && ($opt_signature_create || $opt_signature_export || $opt_signature_import)) {
  die "Sorry, no digest calculation and signature handling at the same time.\n";
}

$opt_signature_tag = ($opt_style eq 'suse' ? 1 : 0) if !defined $opt_signature_tag;

get_fragments_value $current_tags;

if($opt_style eq 'suse') {
  set_tag $current_tags, { key => "check", value => 1 } if $opt_check;
}
else {
  # MD5 has a size of 16 bytes; 60 / $opt_fragments must not be larger than that
  die "Unsupported number of fragments: $opt_fragments\n" if $opt_fragments < 4;
  $signature_key = "\U$signature_key";
  set_tag $current_tags, { key => "RHLISOSTATUS", value => $opt_supported ? 1 : 0 } if $opt_supported || $opt_digest;
}

if($opt_digest) {
  if($opt_style eq 'suse') {
    get_pad_value $image_data, $current_tags;
  }
  else {
    get_skip_value $image_data, $current_tags;
  }
}

if($opt_tags_export) {
  export_tags $image_data, $opt_tags_export;

  exit 0;
}

if($opt_signature_export) {
  export_signature $image_data, $opt_signature_export;

  exit 0;
}

if($opt_signature_create) {
  create_signature_block_if_missing $image_data;
  create_signature $image_data, $opt_signature_create;

  exit 0;
}

if($opt_signature_import) {
  create_signature_block_if_missing $image_data;
  import_signature $image_data, $opt_signature_import;

  exit 0;
}

if(my $sig = get_tag $current_tags, $signature_key) {
  $image_data->{signature_start} = $sig->{value} + 0;
}

prepare_buffer $image_data;

# calculate digest
calculate_digest $image_data if $opt_digest;

# finally close file handle (had been opened in read_image_blob())
close $image_data->{fh};

if($image_data->{signature_start}) {
  set_tag $current_tags, { key => $signature_key, value => $image_data->{signature_start} };
}

for (@opt_add_tag) {
  set_tag $current_tags, parse_tag($_);
}

for (@opt_remove_tag) {
  $current_tags = remove_tag $current_tags, $_;
}

if($opt_digest && $opt_style ne 'suse') {
  my $msg = "THIS IS NOT THE SAME AS RUNNING MD5SUM ON THIS ISO!!";
  $current_tags = remove_tag $current_tags, $msg;
  set_tag $current_tags, { key => $msg };
}

write_tags $image_data, $current_tags if $image_data->{write};

# finally, print current tags
for (@{$image_data->{write} ? $current_tags : $old_tags}) {
  print "$_->{key}";
  print " = $_->{value}" if defined $_->{value};
  print "\n";
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# usage(exit_code)
#
# Print help message and exit program with exit_code.
#
sub usage
{
  (my $msg = <<"  = = = = = = = =") =~ s/^ {4}//mg;
    Usage: tagmedia [OPTIONS] IMAGE

    Add/remove tags to installation media. If a digest is added, the media can be verified
    with checkmedia (both rh and suse style) or checkisomd5 (rh style only).

    The embedded digests can optionally be signed to ensure their authenticity.

    IMAGE is an installation medium; either ISO image or disk image.

    General options:

      --style STYLE             Data format. STYLE can be either rh or suse (default:
                                auto-detected).
      --version                 Show version.
      --verbose                 More logging. Repeat for even more logging.
      --help                    Write this help text.

    Tag related options:

      --show                    Show current tags (default if no option is given).
      --add-tag FOO=BAR         Add tag FOO with value BAR.
      --remove-tag FOO          Remove tag FOO.
      --clean                   Remove all tags.
      --export-tags FILE        Export raw tag data to FILE.

    Digest related options:

      --digest DIGEST           Add digest DIGEST (suse style: md5, sha1, sha224, sha256, sha384, sha512,
                                rh style: md5).
      --fragments N             Split image into N fragments with individual digests (suse style default: 0,
                                rh style default: 20)
      --pad N                   Ignore N 2 kiB blocks of padding at image end (suse style).
      --skip N                  Ignore N 2 kiB blocks at image end (rh style, default: 15).
      --check                   Tell installer to run media check at startup (suse style).
      --supported               Set supported flag (rh style).
      --signature-tag           When adding a digest, check for signature block and add signature tag if
                                one is found (default for style suse).
      --no-signature-tag        When adding a digest, do not check for signature block (default for style rh).

    Signature related options:

      --create-signature KEYID  Sign meta data in IMAGE with GPG key KEYID. The public part of KEYID is
                                exported to the file IMAGE.key.
      --import-signature FILE   Import signature from FILE.
      --export-signature FILE   Export signature to FILE.

  = = = = = = = =

  print $msg;

  exit shift;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# read_image_blob(image)
#
# Read first 64 kiB.
# Note: leaves $image_data ->{fh} open for calculate_digest() to continue reading.
#
# image: hash with image related data
#
sub read_image_blob
{
  my ($image) = @_;

  my $blob_size = 0x10000;
  $image->{blob_blocks} = $blob_size >> 9;		# in 0.5 kiB units

  die "$image->{name}: $!\n" unless open $image->{fh}, $image->{name};
  die "$image->{name}: $!\n" unless sysread $image->{fh}, $image->{blob}, $blob_size;
  die "$image->{name}: file too short\n" if $blob_size != length $image->{blob};
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# get_image_type(image)
#
# Analyze image type and get some basic data.
#
# image: hash with image related data
# image->{blob}: buffer containing a sufficiently large portion of the image (36 kiB)
#
sub get_image_type
{
  my ($image) = @_;

  # Get iso size from ISO9660 header.
  #
  # Don't verify too much - most of the header might be gone. Since in
  # ISO9660 sizes are stored both-endian we can do a plausibility check
  # which should be enough.
  #
  my $iso_magic_ok = substr($image->{blob}, ISO9660_MAGIC_START, 8) eq "\x01CD001\x01\x00";
  my $little = 4 * unpack("V", substr($image->{blob}, ISO9660_VOLUME_SIZE, 4));
  my $big = 4 * unpack("N", substr($image->{blob}, ISO9660_VOLUME_SIZE + 4, 4));
  my $stat_size = (-s $image->{name}) / 512;

  if(
    $iso_magic_ok &&
    $little &&
    $little == $big &&
    # note: $stat_size will be 0 for block devices
    ($stat_size == 0 || $little <= $stat_size)
  ) {
    $image->{iso_blocks} = $little;
  }

  # Scan mbr for last primary partition.
  #
  # Ignore EFI system partition.
  #
  # Set $image->{part_start}, $image->{part_blocks} (in 0.5 kiB units).
  #
  if(substr($image->{blob}, MBR_MAGIC_START, 2) eq "\x55\xaa") {
    for (my $idx = 0; $idx < 4; $idx++) {
      my ($boot, $type, $start, $size) = unpack(
        "Cx3Cx3VV",
        substr($image->{blob}, MBR_PARTITION_TABLE + 0x10 * $idx, 0x10)
      );
      # if there's a partition starting at block 0, skip this and don't report a partition
      # this partition may have type 0
      last if !($boot & 0x7f) && $size && !$start;

      if(
        $type &&
        $type != 0xef &&
        !($boot & 0x7f) &&
        $size &&
        $start + $size > $image->{part_start} + $image->{part_blocks}
      ) {
        $image->{part_start} = $start;
        $image->{part_blocks} = $size;
      }
    }
  }

  if($opt_verbose >= 1) {
    print "iso blocks = $image->{iso_blocks}";
    print ", partition blocks = $image->{part_blocks} @ $image->{part_start}" if $image->{part_blocks};
    print "\n";
  }

  die "$image->{name}: unsupported image format\n" unless $image->{iso_blocks} || $image->{part_blocks};
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# get_pad_value(image, tags)
#
# Get pad value to use.
#
# image: hash with image related data
# tags: array ref with tag hashes
#
# Note: this uses the value passed via '--pad' option and stores it as
# 'pad' tag.
#
sub get_pad_value
{
  my ($image, $tags) = @_;
  my $padding_set;

  if($image->{iso_blocks}) {
    my $pad_tag = get_tag $tags, "pad";

    my $pad_value = $opt_pad;
    $pad_value = $pad_tag->{value} if $pad_tag && !defined $pad_value;

    set_tag $tags, { key => "pad", value => $pad_value } if defined $pad_value;

    $image->{pad_blocks} = $pad_value << 2;
    $image->{iso_blocks} -= $image->{pad_blocks};

    die "pad value too large\n" if $image->{iso_blocks} <= 0;
  }
  else {
    remove_tag $tags, "pad";
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# get_skip_value(image, tags)
#
# Get skip value to use.
#
# image: hash with image related data
# tags: array ref with tag hashes
#
# Note: this uses the value passed via '--skip' option and stores it as
# 'SKIPSECTORS' tag.
#
sub get_skip_value
{
  my ($image, $tags) = @_;
  my $padding_set;

  if($image->{iso_blocks}) {
    my $skip_tag = get_tag $tags, "SKIPSECTORS";

    my $skip_value = $opt_skip;
    $skip_value = $skip_tag->{value} if $skip_tag && !defined $skip_value;

    set_tag $tags, { key => "SKIPSECTORS", value => $skip_value } if defined $skip_value;;

    $skip_value = SKIP_DEFAULT if !defined $skip_value && $opt_style eq 'rh';

    $image->{skip_blocks} = $skip_value << 2;
    $image->{iso_blocks} -= $image->{skip_blocks};

    die "skip value too large\n" if $image->{iso_blocks} <= 0;
  }
  else {
    remove_tag $tags, "SKIPSECTORS";
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# get_fragments_value(tags)
#
# Get fragment count value to use.
#
# tags: array ref with tag hashes
#
sub get_fragments_value
{
  my ($tags) = @_;

  if(! defined $opt_fragments) {
    my $fragments_tag = get_tag $tags, "fragment count";
    $opt_fragments = $fragments_tag->{value} if $fragments_tag;
    $opt_fragments = FRAGMENTS_DEFAULT if !defined $opt_fragments && $opt_style eq 'rh';
  }

  return if $opt_style eq 'suse' && $opt_fragments == 0;

  if(
    $opt_fragments < 1 ||
    # must be divisable
    TOTAL_FRAGMENT_SUM_SIZE % $opt_fragments ||
    # MD5 has a size of 16 bytes; (60 / $opt_fragments) must not be larger than that
    ($opt_style eq 'rh' && $opt_fragments < 4)
  ) {
    die "Unsupported number of fragments: $opt_fragments\n" if $opt_fragments < 4;
  }

  $fragment_sum_size =  TOTAL_FRAGMENT_SUM_SIZE / $opt_fragments;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# tags = read_tags(image)
#
# 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 ($image) = @_;

  my $buf = substr($image->{blob}, ISO9660_APP_DATA_START, ISO9660_APP_DATA_LENGTH);
  die "$image->{name}: unsupported image format\n" unless $buf  =~ /^[0-9A-Za-z_=,;! \x00]{512}$/;
  $buf =~ s/[\s\x00]*$//;

  my $tags = [];

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

  return $tags;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# write_tags(image, $tags)
#
# Insert tags into image fragment.
# Note: this does not write anything to disk!
#
# image: hash with image related data
# image->{blob}: buffer containing a sufficiently large portion of the image (36 kiB)
# tags: array ref with tags
#
sub write_tags
{
  my ($image, $tags) = @_;
  my $buf;

  for my $tag (@$tags) {
    $buf .= ";" if defined $buf;
    $buf .= $tag->{key};
    # yes, that's how it is: https://github.com/rhinstaller/isomd5sum/blob/41904dbcd95563070b275f629e8ca6e558775b04/utilities.c#L142-L186
    my $sep = $opt_style eq 'suse' || $tag->{key} eq "RHLISOSTATUS" ? "=" : " = ";
    $buf .= "$sep$tag->{value}" if defined $tag->{value};
  }

  die "tags too large: \"$buf\"\n" if length($buf) > ISO9660_APP_DATA_LENGTH;
  $buf .= " " x (ISO9660_APP_DATA_LENGTH - length($buf));

  my $len;
  die "$image->{name}: $!\n" unless open $image->{fh}, "+<", $image->{name};
  die "$image->{name}: $!\n" unless seek $image->{fh}, ISO9660_APP_DATA_START, 0;
  die "$image->{name}: $!\n" unless $len = syswrite $image->{fh}, $buf, ISO9660_APP_DATA_LENGTH;
  die "$image->{name}: failed to update image\n" unless $len == ISO9660_APP_DATA_LENGTH;

  close $image->{fh};
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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 = remove_tag(tags, key)
#
# Remove tag from tag array with specified key.
# Returns new tag array.
#
# tags: array ref with tag hashes
# key: string
#
sub remove_tag
{
  my ($tags, $key) = @_;

  return [ grep { $_->{key} ne $key } @$tags ];
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# prepare_buffer(image)
#
# Reset some areas in image blob to defined values before starting digest calculation.
#
# image: hash with image related data
# image->{blob}: buffer containing a sufficiently large portion of the image (36 kiB)
#
sub prepare_buffer
{
  my $image = $_[0];

  substr($image->{blob}, MBR_OFFSET, MBR_LENGTH) = "\x00" x MBR_LENGTH if $opt_style eq 'suse';
  substr($image->{blob}, ISO9660_APP_DATA_START, ISO9660_APP_DATA_LENGTH) = " " x ISO9660_APP_DATA_LENGTH;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# process_digest(digest, start, blocks, buf_start, buf_blocks, buf)
#
# Update digest.
#
# The total digest needs to be calculated from start to start + blocks. The
# current buffer in buf holds file data from buf_start to buf_start + buf_blocks.
#
# digest: digest ref
# start: region start block
# blocks: region blocks
# buf_start: buffer start block
# buf_blocks: buffer blocks
# buf: buffer ref
#
# Note: a block is 0.5 kiB.
#
sub process_digest
{
  my ($digest, $start, $blocks, $buf_start, $buf_blocks, $buf) = @_;

  my $end = $start + $blocks;
  my $buf_end = $buf_start + $buf_blocks;

  return if $start >= $buf_end || $end <= $buf_start;

  if($start > $buf_start) {
    my $skip = $start - $buf_start;
    $buf_blocks -= $skip;
    $buf_start = $start;
    $buf = substr($buf, $skip << 9);
  }

  if($buf_end > $end) {
    $buf_blocks -= $buf_end - $end;
    $buf_end = $end;
    $buf = substr($buf, 0, $buf_blocks << 9);
  }

  $digest->add($buf);
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# calculate_digest($image)
#
# Calculate digest.
#
# Note: $image_data->{fh} has been opened in read_image_blob(). We just continue
# reading here.
#
# This function calculates 2 different digests:
#
#   (1) $image->{iso_blocks} starting from 0, plus $image->{pad_blocks} of zeros
#   (2) $image->{part_blocks} starting from $image->{part_start}
#
# $image->{blob_blocks} have already been read and are cached in $image->{blob}.
#
# Note: padding has been subtracted from $image->{iso_blocks}.
#
sub calculate_digest
{
  my ($image) = @_;

  my $iso_start = 0;
  my $iso_blocks = $image->{iso_blocks};
  my $part_start = $image->{part_start};
  my $part_blocks = $image->{part_blocks};

  my $full_blocks = $part_start + $part_blocks;
  $full_blocks = $iso_blocks if $iso_blocks > $full_blocks;

  my $pos = $image->{blob_blocks};
  my $step_blocks = 2048;	# 1 MiB chunks
  my $fragment_bytes = int(($iso_blocks << 9) / ($opt_fragments + 1));

  if($opt_fragments) {
    # to get fragment checksum right
    $step_blocks = 64;		# 32 kiB chunks
  }

  print "full blocks = $full_blocks, fragment bytes = $fragment_bytes\n" if $opt_verbose >= 1 && $opt_fragments;

  process_digest $digest_iso, $iso_start, $iso_blocks, 0, $pos, $image->{blob};
  process_digest $digest_part, $part_start, $part_blocks, 0, $pos, $image->{blob};

  my $last_fragment = 0;
  my $fragment_digest;

  while($pos < $full_blocks) {
    my $buf;
    my $to_read = $full_blocks - $pos;
    $to_read = $step_blocks if $step_blocks < $to_read;

    my $read_len = sysread $image->{fh}, $buf, $to_read << 9;
    die "$image->{name}: read error: $to_read blocks @ $pos\n" if $read_len != $to_read << 9;

    normalize_buffer $image, $pos, \$buf;

    process_digest $digest_iso, $iso_start, $iso_blocks, $pos, $to_read, $buf;
    process_digest $digest_part, $part_start, $part_blocks, $pos, $to_read, $buf;

    if($opt_fragments) {
      my $fragment = int(($pos << 9) / $fragment_bytes);
      if($fragment != $last_fragment) {
        my @d = unpack "C*", $digest_iso->clone->digest;
        for (my $i = 0; $i < $fragment_sum_size && defined $d[$i]; $i++) {
          $fragment_digest .= substr sprintf("%x", $d[$i]), 0, 1;
        }
        my $d = $digest_iso->clone->hexdigest;
        printf "fragment %2d, blocks %8d: $opt_digest %s - %s\n", $fragment, $pos + $to_read, $d, substr($fragment_digest, -$fragment_sum_size, $fragment_sum_size) if $opt_verbose >= 2;

        $last_fragment = $fragment;
      }
    }

    $pos += $to_read;
  }

  # store digest over ISO image
  if($image->{iso_blocks}) {
    my $buf = "\x00" x 0x200;
    my $pad_blocks = $image->{pad_blocks};

    while($pad_blocks-- > 0) {
      $digest_iso->add($buf);
    }

    $digest_iso = $digest_iso->hexdigest;

    if($opt_style eq 'suse') {
      set_tag $current_tags, { key => "${opt_digest}sum", value => $digest_iso };
      if($opt_fragments) {
        set_tag $current_tags, { key => "fragment sums", value => $fragment_digest };
        set_tag $current_tags, { key => "fragment count", value => $opt_fragments };
      }
    }
    else {
      set_tag $current_tags, { key => "SKIPSECTORS", value => $image->{skip_blocks} >> 2 };
      set_tag $current_tags, { key => "FRAGMENT SUMS", value => $fragment_digest };
      set_tag $current_tags, { key => "FRAGMENT COUNT", value => $opt_fragments };
      set_tag $current_tags, { key => "ISO \U${opt_digest}sum", value => $digest_iso };
    }
  }

  # store digest over partition
  if($image->{part_blocks} && $opt_style eq 'suse') {
    $digest_part = $digest_part->hexdigest;
    set_tag $current_tags, {
      key => "partition",
      value => "$image->{part_start},$image->{part_blocks},$digest_part"
    }
  }

  # Check first block of the skipped region in case the signature block has
  # been placed there.
  #
  # This is just for auto-detecting the signature location; it has no effect
  # on the digest calculation.
  if($opt_signature_tag && $opt_style ne 'suse' && $image->{skip_blocks} >= 4 && !$image->{signature_start}) {
    my $buf;
    my $read_len = sysread $image->{fh}, $buf, 4 << 9;
    if(SIGNATURE_MAGIC eq substr($buf, 0, length SIGNATURE_MAGIC)) {
      $image->{signature_start} = $pos;
    }
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# export_tags(image, file)
#
# Export raw tag data from image to file.
#
# image: hash with image related data
# file: file name
#
sub export_tags
{
  my ($image, $file) = @_;

  my $buf = substr($image->{blob}, ISO9660_APP_DATA_START, ISO9660_APP_DATA_LENGTH);

  if(open my $f, ">$file") {
    print $f $buf;
    close $f;
  }
  else {
    die "$file: $!\n";
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# create_signature_block_if_missing(image)
#
# If there's no signature block, create a signature block at the end of the
# ISO in the skipped area - if one exists.
#
# image: hash with image related data
#
sub create_signature_block_if_missing
{
  my ($image) = @_;
  my $sig = get_tag $current_tags, $signature_key;

  return if $sig;

  get_skip_value $image, $current_tags;

  return if !($image->{skip_blocks} && $image->{iso_blocks});

  $image->{signature_start} = $image->{iso_blocks};
  $sig = { key => $signature_key, value => $image->{signature_start} };
  set_tag $current_tags, $sig;

  # empty signature block
  my $buf = SIGNATURE_MAGIC . ("\x00" x 0x800);

  # update tags
  # note: implicitly closes $image->{fh}
  write_tags $image, $current_tags;

  # re-read meta data to be in sync
  # note: implicitly re-opens $image->{fh}
  read_image_blob $image;
  close $image->{fh};

  die "$image->{name}: $!\n" unless open $image->{fh}, "+<", $image->{name};
  die "$image->{name}: $!\n" unless seek $image->{fh}, $sig->{value} * 0x200, 0;
  die "$image->{name}: $!" unless 0x800 == syswrite $image->{fh}, $buf, 0x800;
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# export_signature(image, file)
#
# Export signature data from image to file.
#
# image: hash with image related data
# file: file name
#
sub export_signature
{
  my ($image, $file) = @_;
  my $sig = get_tag $current_tags, $signature_key;

  my $buf;

  die "$image->{name}: no signature location found\n" if !$sig || $sig->{value} == 0;
  die "$image->{name}: $!\n" unless seek $image->{fh}, $sig->{value} * 0x200, 0;
  die "$image->{name}: $!\n" unless 0x800 == sysread $image->{fh}, $buf, 0x800;

  die "$image->{name}: invalid signature block\n" if SIGNATURE_MAGIC ne substr($buf, 0, length SIGNATURE_MAGIC);

  substr($buf, 0, 0x40) = "";

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

  if(open my $f, ">$file") {
    print $f $buf;
    close $f;
  }
  else {
    die "$file: $!\n";
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# import_signature(image, file)
#
# Import signature data from file to image.
#
# image: hash with image related data
# file: file name
#
sub import_signature
{
  my ($image, $file) = @_;
  my $sig = get_tag $current_tags, $signature_key;

  my $buf;

  die "$image->{name}: no signature location found\n" if !$sig || $sig->{value} == 0;
  die "$image->{name}: $!\n" unless seek $image->{fh}, $sig->{value} * 0x200, 0;
  die "$image->{name}: $!\n" unless 0x800 == sysread $image->{fh}, $buf, 0x800;

  die "$image->{name}: invalid signature block\n" if SIGNATURE_MAGIC ne substr($buf, 0, length SIGNATURE_MAGIC);

  my $buf2;

  if(open my $f, "<$file") {
    local $/;
    $buf2 = <$f>;
    close $f;
  }
  else {
    die "$file: $!\n";
  }

  if(length($buf2) > 0x800 - 0x40) {
    die "$file: signature too large\n";
  }

  $buf = substr($buf, 0, 0x40) . $buf2;
  $buf .= "\x00" x (0x800 - length($buf));

  die "$image->{name}: $!\n" unless open $image->{fh}, "+<", $image->{name};
  die "$image->{name}: $!\n" unless seek $image->{fh}, $sig->{value} * 0x200, 0;
  die "$image->{name}: $!\n" unless 0x800 == syswrite $image->{fh}, $buf, 0x800;
  close $image->{fh};
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# create_signature(image, keyid)
#
# Create signature data using GPG key with keyid.
# Fore convenience, export the public key to a file "$image->{name}.key".
#
# image: hash with image related data
# keyid: GPG keyid
#
sub create_signature
{
  my ($image, $keyid) = @_;

  my $tag_block = substr($image->{blob}, ISO9660_APP_DATA_START, ISO9660_APP_DATA_LENGTH);

  if(open my $p, "| gpg --local-user '$keyid' --batch --yes --armor --detach-sign - >$image->{name}.tmp_key") {
    print $p $tag_block;
    close $p;
    import_signature $image, "$image->{name}.tmp_key";
    system "gpg --batch --yes --armor --export '$keyid' >$image->{name}.key";
    print "public key for verifying $image->{name} written to $image->{name}.key\n";
  }
  unlink "$image->{name}.tmp_key";
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# normalize_buffer(image, pos, buffer_ref)
#
# If buffer contains the signature block (2 kiB), clear signature block.
# A cleared signature block containts 0x40 bytes magic header, the rest is
# all zeros (0).
#
# This function looks for a signature block and returns its position in
# $image->{signature_start} if $image->{signature_start} is unset.
#
# image: hash with image related data
# pos: block number of buffer start
# buffer_ref: reference to buffer; buffer may get modified
#
sub normalize_buffer
{
  my ($image, $pos, $buf_ref) = @_;
  my $blocks = length($$buf_ref) >> 9;

  if($opt_signature_tag && !$image->{signature_start}) {
    for (my $i = 0; $i < $blocks; $i++) {
      if(SIGNATURE_MAGIC eq substr($$buf_ref, $i << 9, length SIGNATURE_MAGIC)) {
        $image->{signature_start} = $pos + $i;
      }
    }
  }

  if($image->{signature_start}) {
    my $signature_len = 4;	# 2 kiB
    my $x = $image->{signature_start} - $pos;
    if($x >= 0 && $x < $blocks) {
      for (my $i = 0; $i < $signature_len && $x + $i < $blocks; $i++) {
        if($i == 0) {
          # leave 0x40 bytes intact in first block
          substr($$buf_ref, ($x << 9) + 0x40, 0x200 - 0x40) = "\x00" x (0x200 - 0x40);
        }
        else {
          substr($$buf_ref, ($x + $i) << 9, 0x200) = "\x00" x 0x200;
        }
      }
    }
  }
}


# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# guess_style(tags)
#
# Guess meta data style based on existing tags.
#
# Return 'suse' (default) or 'rh'.
#
# tags: array ref with tag hashes
# tag: tag hash ref ('key', 'value' pair)
#
sub guess_style
{
  my ($tags) = @_;
  my $style = 'suse';

  for my $tag (@$tags) {
    $style = 'rh' if $tag->{key} =~ /^(SKIPSECTORS|RHLISOSTATUS|ISO .*SUM)$/;
  }

  print "detected $style style\n" if $opt_verbose >= 1;

  return $style;
}
