File computeblocklists of Package build

#!/usr/bin/perl -w
# compute the blocks used by a file
# usage:
# computeblocklists [options] <files...>
# options:
# --padstart NUM, --padend NUM, --verbose
#
# output:
# <file base name> <size> <blocksize> <block numbers...>
#
# a block is either a number or a range (start-end)
#

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

use strict;

# the ioctls we use
my $FIBMAP = 1;
my $FIGETBSZ = 2;
my $FIEMAP = 0xc020660b;	# _IOWR('f', 11, struct fiemap)

# powerpc, mips, sparc, and alpha have 3 direction bits
# and represent _IOC_NONE as 1 instead of 0.
sub alt_ioctl($) {
  my ($ioctl_nr) = @_;
  my $size = ($ioctl_nr >> 16) & 0x3fff;
  my $dir = ($ioctl_nr >> 30);
  my $base = $ioctl_nr & 0x1fffffff;
  die "invalid size $size" if ($size > (1 << 13));
  return $base | ($dir + 1) << 29;
}

#
# Use FIBMAP to gather block lists, block-by-block
# This is the older, slower way to iterate over file extents but
# will generally work on older kernels. The block number also
# must fit into an integer limiting the size of the file system.
#
sub fibmap_blocklist($$$) {
  my ($fd, $filesize, $bsize) = @_;

  my $exts = '';
  my $blocks = int(($filesize + $bsize - 1) / $bsize);
  die("file is too big for fibmap\n") if $blocks * $bsize < $filesize;
  my ($firstblock, $lastblock);
  for (my $cnt = 0; $cnt < $blocks; ++$cnt) {
    my $block = pack('I', $cnt);
    if (not defined ioctl($fd, $FIBMAP, $block)) {
      if (not defined ioctl($fd, alt_ioctl($FIBMAP), $block)) {
	die("fibmap ioctl: $!\n");
      }
    }
    $block = unpack('I', $block);
    if (defined($firstblock) && $block == ($firstblock ? $lastblock + 1 : 0)) {
      $lastblock++;	# continue run
      next;
    }
    # finish old run
    $exts .= "-$lastblock" if defined($firstblock) && $firstblock != $lastblock;
    # start new run
    $exts .= " $block";
    $firstblock = $lastblock = $block;
  }
  # finish last run
  $exts .= "-$lastblock" if defined($firstblock) && $firstblock != $lastblock;
  return $exts;
}

#
# Use the FIEMAP ioctl to gather block lists, defined extent at a time
# This is the newer way to gather extent information.  We iterate the file
# up to 50 extents at a time, each describing a contiguous, non-hole, range.
#
# see /usr/include/linux/fiemap.h for definitions of the flags used below
#
my $q_emu = 0;		# 0=no emu, 1=little endian, 2=big endian

sub pack_Q {
  my ($v) = @_;
  return pack('Q', $v) unless $q_emu;
  my $v1 = int($v / 4294967296);
  my $v2 = int($v - 4294967296 * $v1);
  ($v1, $v2) = ($v2, $v1) if $q_emu == 1;
  return pack('LL', $v1, $v2);
}

sub unpack_Q {
  return unpack('Q', $_[0]) unless $q_emu;
  my ($v1, $v2) = unpack('LL', $_[0]);
  ($v1, $v2) = ($v2, $v1) if $q_emu == 1;
  my $v = $v1 * 4294967296 + $v2;
  die("unpack_Q: number too big\n") if int($v - 4294967296 * $v1) != $v2;
  return $v;
}

# Convert a size into a block number and an offset.
sub bytes_in_blocks($$) {
  my ($bytes, $bsize) = @_;
  my $blk = int($bytes / ($bsize * 65536)) * 65536;	# work with 32bit int
  $blk += int(($bytes - $blk * $bsize) / $bsize);
  return ($blk, $bytes - $blk * $bsize);
}

# Create an extent descriptor
sub createext($$$;$) {
  my ($start, $end, $bsize, $islast) = @_;
  die if $start > $end;
  my ($startblk, $startoff) = bytes_in_blocks($start, $bsize);
  my ($endblk, $endoff) = bytes_in_blocks($end, $bsize);
  $endoff = $bsize - 1 if $islast;
  my $ext = " $startblk";
  $ext .= ":$startoff" if $startoff != 0;
  if ($startblk != $endblk || $endoff != $bsize - 1) {
    $ext .= "-$endblk";
    $ext .= ":$endoff" if $endoff != $bsize - 1;
  }
  return $ext;
}

sub fiemap_blocklist($$$) {
  my ($file, $filesize, $bsize) = @_;

  # check if pack/unpack supports the Q template
  $q_emu = 0;
  eval { die if unpack('Q', pack('Q', 1)) != 1 };
  if ($@) {
    # nope, fallback to encode/decode helpers
    $q_emu = unpack('C', pack('L', 1)) ? 1 : 2;
  }

  my $exts = '';
  my $offset = 0;
  while ($offset < $filesize) {
    my $flags_in = 0x00000001; # FIEMAP_FLAG_SYNC
    my $x = pack("a8a8IIIx4.", pack_Q($offset), pack_Q($filesize), $flags_in, 0, 50, 4096);

    if (not defined ioctl($file, $FIEMAP, $x)) {
      if (not defined ioctl($file, alt_ioctl($FIEMAP), $x)) {
	die("fiemap ioctl: $!\n");
      }
    }

    my ($flags, $count, @extents) = unpack('x16IIx8(a8a8a8a8a8IIII)[50]', $x);
    last if $count == 0;	# rest is a hole

    for (my $i = 0; $i < $count; $i++) {
      $extents[$_] = unpack_Q($extents[$_]) for 0, 1, 2;
      my ($logical, $physical, $length, $resv1, $resv2, $flags) = splice(@extents, 0, 9);
      die("logical offset outside of file?\n") if $logical < 0 || $logical >= $filesize;
      die("going back in file?\n") if $offset > $logical;
      die("extent with bad size?\n") if $length <= 0;
      # add a hole entry if needed
      $exts .= createext(0, $logical - $offset - 1, $bsize) if $offset < $logical;
      my $islast = $logical + $length >= $filesize ? 1 : 0;
      # Not a hole but for these purposes we should treat it as one
      if ($flags & 0x00000800) { # UNWRITTEN
        $exts .= createext(0, $length - 1, $bsize, $islast);
      } elsif ($flags & 0x00000008) { # ENCODED
	die("extent mapped but is encoded\n");
      # UNKNOWN|DELALLOC|DATA_ENCRYPTED|NOT_ALIGNED|DATA_INLINE|DATA_TAIL
      } elsif ($flags & 0x00000786) {
	die("extent cannot be block-mapped\n");
      } else {
        $exts .= createext($physical, $physical + $length - 1, $bsize, $islast);
      }
      $offset = $logical + $length;
    }
  }
  $exts .= createext(0, $filesize - $offset - 1, $bsize, 1) if $offset < $filesize;
  return $exts;
}

my ($opt_padstart, $opt_padend, $opt_verbose, $opt_manifest, $opt_mani0, $opt_fibmap);
$opt_verbose = 0;

while (@ARGV)  {
  if ($ARGV[0] eq '--padstart') {
    shift @ARGV;
    $opt_padstart = shift @ARGV;
    next;
  }
  if ($ARGV[0] eq '--padend') {
    shift @ARGV;
    $opt_padend = shift @ARGV;
    next;
  }
  if ($ARGV[0] eq '--verbose' || $ARGV[0] eq '-v') {
    shift @ARGV;
    $opt_verbose++;
    next;
  }
  if ($ARGV[0] eq '-0') {
    shift @ARGV;
    $opt_mani0 = 1;
    next;
  }
  if ($ARGV[0] eq '--manifest') {
    shift @ARGV;
    $opt_manifest = shift @ARGV;
    next;
  }
  if ($ARGV[0] eq '--fibmap') {
    shift @ARGV;
    $opt_fibmap = 1;
    next;
  }
  last;
}

print "\n"x$opt_padstart if $opt_padstart;

if ($opt_manifest) {
  if ($opt_manifest eq '-') {
    open(MANIFEST, '<&STDIN') || die("STDIN dup: $!\n");
  } else {
    open(MANIFEST, '<', $opt_manifest) || die("$opt_manifest: $!\n");
  }
}

while (1) {
  my $file;
  if (@ARGV) {
    $file = shift @ARGV;
  } elsif ($opt_manifest) {
    if ($opt_mani0) {
      local $/ = "\0";
      $file = <MANIFEST>;
      last unless defined $file;
      $file =~ s/\0$//s;
    } else {
      $file = <MANIFEST>;
      last unless defined $file;
      chomp $file;
    }
  } else {
    last;
  }
  my $n = $file;
  $n =~ s/([\000-\037 %])/sprintf("%%%02X", ord($1))/ges;
  if (-l $file) {
    print STDERR "$file\n" if $opt_verbose && !($opt_verbose == 1 && $file =~ /^KIWI\/.*\//);
    my $c = readlink($file);
    die("$file: readlink: $!\n") unless defined $c;
    if ("/$c/" =~ /\/\.?\//s) {
      print STDERR "$file: bad symlink ($c), ignored\n";
      next;
    }
    if ("/$c/" =~ /^((?:\/\.\.)+)\/(.*?)$/s) {
      my ($head, $tail) = ($1, $2);
      if (("/$tail/" =~ /\/\.\.\//s) || (($head =~ y!/!!) > ($file =~ y!/!!))) {
        print STDERR "$file: bad symlink ($c), ignored\n";
        next;
      }
    } else {
      if ("/$c/" =~ /\/\.\.\//s) {
        print STDERR "$file: bad symlink ($c), ignored\n";
        next;
      }
    }
    $c =~ s/([\000-\037 %])/sprintf("%%%02X", ord($1))/ges;
    print "l $n $c\n";
    next;
  } elsif (-d _) {
    print STDERR "$file\n" if $opt_verbose && ($opt_verbose > 1 || $file =~ /^KIWI\/[^\/]*$/);
    print "d $n\n";
    next;
  } elsif (! -f _) {
    print STDERR "$file: unsupported file type, ignored\n";
    next;
  }
  print STDERR "$file\n" if $opt_verbose && !($opt_verbose == 1 && $file =~ /^KIWI\/.*\//);

  my $fd = undef;
  if (!open($fd, '<', $file)) {
    print STDERR "$file: $!\n";
    next;
  }

  my @stat = stat($fd);
  die unless @stat;
  my $filesize = $stat[7];
  if ($filesize == 0) {
    print "f $n 0\n";
    close($fd);
    next;
  }

  my $bsize = pack('I', 0);
  if (not defined ioctl($fd, $FIGETBSZ, $bsize)) {
    if (not defined ioctl($fd, alt_ioctl($FIGETBSZ), $bsize)) {
      die("$file: FIGETBSZ failed: $!\n");
    }
  }
  $bsize = unpack('I', $bsize);
  die("$file: illegal blocksize $bsize\n") unless $bsize > 0;

  my $exts;
  if (!$opt_fibmap) {
    eval { $exts = fiemap_blocklist($fd, $filesize, $bsize) };
    warn($@) if $@;
  }
  if (!defined($exts)) {
    eval { $exts = fibmap_blocklist($fd, $filesize, $bsize) };
    warn($@) if $@;
  }
  die "$file: could not get extent list\n" unless defined $exts;
  print "f $n $filesize $bsize$exts\n";
  close($fd);
}

print "\n"x$opt_padend if $opt_padend;