#!/usr/bin/perl -w
#
# zipl_helper.device-mapper: print zipl parameters for a device-mapper device
#
# Copyright IBM Corp. 2009, 2017
#
# s390-tools is free software; you can redistribute it and/or modify
# it under the terms of the MIT license. See LICENSE for details.
#
# Depending on the name by which the script is called, it serves one of two
# purposes:
#
# 1. Usage: zipl_helper.device-mapper <target directory> or
#                                     <major:minor of target device>
#
# This tool attempts to obtain zipl parameters for a target directory or
# partition located on a device-mapper device. It assumes that the
# device-mapper table for this device conforms to the following rules:
# - directory is located on a device consisting of a single device-mapper
#   target
# - only linear, mirror and multipath targets are supported
# - supported physical device types are DASD and SCSI devices
# - all of the device which contains the directory must be located on a single
#   physical device (which may be mirrored or accessed through a multipath
#   target)
# - any mirror in the device-mapper setup must include block 0 of the
#   physical device
#
# 2. Usage: chreipl_helper.device-mapper <major:minor of target device>
#
# This tool identifies the physical device which contains the specified
# device-mapper target devices. If the physical device was found, its
# major:minor parameters are printed. Otherwise, the script exits with an
# error message and a non-zero return code.
#

use strict;
use File::Basename;
use POSIX qw/locale_h/;

# Required tools
our $dmsetup = "dmsetup";
our $mknod = "mknod";
our $dasdview = "dasdview";
our $blockdev = "blockdev";

# Constants
our $SECTOR_SIZE = 512;
our $DASD_PARTN_MASK = 0x03;
our $SCSI_PARTN_MASK = 0x0f;

# Internal constants
our $DEV_TYPE_CDL = 0;
our $DEV_TYPE_LDL = 1;
our $DEV_TYPE_FBA = 2;
our $DEV_TYPE_SCSI = 3;

our $TARGET_START = 0;
our $TARGET_LENGTH = 1;
our $TARGET_TYPE = 2;
our $TARGET_DATA = 3;

our $TARGET_TYPE_LINEAR = 0;
our $TARGET_TYPE_MIRROR = 1;
our $TARGET_TYPE_MULTIPATH = 2;

our $LINEAR_MAJOR = 0;
our $LINEAR_MINOR = 1;
our $LINEAR_START_SECTOR = 2;

our $MIRROR_MAJOR = 0;
our $MIRROR_MINOR = 1;
our $MIRROR_START_SECTOR = 2;

our $MULTIPATH_MAJOR = 0;
our $MULTIPATH_MINOR = 1;

sub get_physical_device_dir($);
sub get_physical_device($$);
sub get_major_minor($);
sub get_table($$);
sub get_linear_data($$);
sub get_mirror_data($$);
sub get_multipath_status($);
sub get_multipath_data($$);
sub filter_table($$$);
sub get_target_start($);
sub get_target_major_minor($);
sub create_temp_device_node($$$);
sub get_blocksize($);
sub get_dasd_info($);
sub get_partition_start($$);
sub is_dasd($);
sub get_partition_base($$$);
sub get_device_characteristics($$);
sub get_type_name($);
sub check_for_mirror($@);
sub get_target_base($$$$@);
sub get_device_name($$);
sub check_tools();

my $phy_geometry;	# Disk geometry of physical device
my $phy_blocksize;	# Blocksize of physical device
my $phy_offset;		# Offset in 512-byte sectors between start of physical
			# device and start of filesystem
my $phy_type;		# Type of physical device
my $phy_bootsectors;	# Size of boot record in 512-byte sectors
my $phy_partstart;	# Partition offset of physical device
my $phy_major;		# Major device number of physical device
my $phy_minor;		# Minor device number of physical device
my @target_list;	# List of dm-targets between filesystem and physical
			# device.
my $base_major;		# Major device number of base device.
my $base_minor;		# Minor device number of base device
my $directory;		# Command line parameter
my $toolname;		# Name of tool

# Start
$toolname = basename($0);

# Setup and use a standard locale to
# avoid localized scripting output
$ENV{LC_ALL} = "C"; # for child processes
setlocale(LC_ALL, "C"); # for current process

# Use alternate code path if called as chreipl helper
if ($toolname eq "chreipl_helper.device-mapper") {
	if (!defined($ARGV[0]) || !($ARGV[0] =~ /^\s*(\d+)\s*:\s*(\d+)\s*$/)) {
		die("Usage: $toolname <major:minor of target devies>\n");
	}
	($phy_major, $phy_minor, $phy_offset, @target_list) =
		get_physical_device($1, $2);
	print("$phy_major:$phy_minor\n");
	exit(0);
}

$directory = $ARGV[0];
if (!defined($directory)) {
	die("Usage: $toolname <target directory> or <major:minor of target devies>\n");
}

# check if needed tools are available
check_tools();

if (($ARGV[0] =~ /^\s*(\d+)\s*:\s*(\d+)\s*$/)) {
    	# Determine physical (non-dm) device on which partition is located
	($phy_major, $phy_minor, $phy_offset, @target_list) =
		get_physical_device($1,$2);
}
else
{
	# Determine physical (non-dm) device on which directory is located
	($phy_major, $phy_minor, $phy_offset, @target_list) =
		get_physical_device_dir($directory);
}

# Determine type and characteristics of physical device
($phy_type, $phy_blocksize, $phy_geometry, $phy_bootsectors, $phy_partstart) =
	get_device_characteristics($phy_major, $phy_minor);

# Handle partitions
if ($phy_partstart > 0) {
	# Only the partition of the physical device is mapped so only the
	# physical device can provide access to the boot record.
	($base_major, $base_minor) =
		get_partition_base($phy_type, $phy_major, $phy_minor);
	# Check for mirror
	check_for_mirror(scalar(@target_list) - 1, @target_list);
	# Adjust filesystem offset
	$phy_offset += $phy_partstart * ($phy_blocksize / $SECTOR_SIZE);
	$phy_partstart = 0;
	# Update device geometry
	(undef, undef, $phy_geometry, undef, undef) =
		get_device_characteristics($base_major, $base_minor);
} else {
	# All of the device is mapped, so the base device is the top most
	# dm device which provides access to boot sectors
	($base_major, $base_minor) =
		get_target_base($phy_major, $phy_minor, 0, $phy_bootsectors,
				@target_list);
}

# Check for valid offset of file system
if (($phy_offset % ($phy_blocksize / $SECTOR_SIZE)) != 0) {
	die("Error: File system not aligned on physical block size\n");
}

# Print resulting information
print("targetbase=$base_major:$base_minor\n");
print("targettype=".get_type_name($phy_type)."\n");
if (defined($phy_geometry)) {
	print("targetgeometry=$phy_geometry\n");
}
print("targetblocksize=$phy_blocksize\n");
print("targetoffset=".($phy_offset / ($phy_blocksize / $SECTOR_SIZE))."\n");

exit(0);

# get_physical_device_from_dir(dir)
# Returns (phy_major, phy_minor, phy_offset, @target_list).
# target_list: [target_data1, target_data2, ..., target_datan]
# target_data: [major, minor, target]
sub get_physical_device_dir($)
{
	my ($directory) = @_;
	my ($major, $minor) = get_major_minor($directory);

	return get_physical_device($major, $minor);
}

# get_physical_device(major, minor)
# Returns (phy_major, phy_minor, phy_offset, @target_list).
# target_list: [target_data1, target_data2, ..., target_datan]
# target_data: [major, minor, target]
sub get_physical_device($$)
{
	my ($major, $minor) = @_;
	my $table;
	my $target;
	my $start;
	my $length;
	my @target_list;

	$table = get_table($major, $minor);
	if (scalar(@$table) == 0) {
		die("Error: Could not retrieve device-mapper information for ".
		    "device '".get_device_name($major, $minor)."'\n");
	}
	# Filesystem must be on a single dm target
	if (scalar(@$table) != 1) {
		die("Error: Unsupported setup: Directory '$directory' is ".
		    "located on a multi-target device-mapper device\n");
	}

	$target = $table->[0];
	push(@target_list, [$major, $minor, $target]);
	$start = $target->[$TARGET_START];
	$length = $target->[$TARGET_LENGTH];
	while (1) {
		# Convert fs_start to offset on parent dm device
		$start += get_target_start($target);
		($major, $minor) = get_target_major_minor($target);
		$table = get_table($major, $minor);
		if (scalar(@$table) == 0) {
			# Found non-dm device
			return ($major, $minor, $start, @target_list);
		}
		# Get target in parent table which contains filesystem
		$table = filter_table($table, $start, $length);
		if (scalar(@$table) != 1) {
			die("Error: Unsupported setup: Could not map ".
			    "directory '$directory' to a single physical ".
			    "device\n");
		}
		$target = $table->[0];
		push(@target_list, [$major, $minor, $target]);
		# Convert fs_start to offset on parent target
		$start -= $target->[$TARGET_START];
	}
}

# get_major_minor(filename)
# Returns: (device major, device minor) of the device containing the
# specified file.
sub get_major_minor($)
{
	my ($filename) = @_;
	my @stat;
	my $dev;
	my $major;
	my $minor;

	@stat = stat($filename);
	if (!@stat) {
		die("Error: Could not stat '$filename'\n");
	}
	$dev = $stat[0];
	$major = ($dev & 0xfff00) >> 8;
	$minor = ($dev & 0xff) | (($dev >> 12) & 0xfff00);

	return ($major, $minor);
}

# get_table(major, minor)
# Returns: [target1, target2, ..., targetn]
# target: [start, length, type, data]
# data: linear_data|mirror_data|multipath_data
sub get_table($$)
{
	my ($major, $minor) = @_;
	my @table;
	my $dev_name = get_device_name($major, $minor);
	local *HANDLE;

	open(HANDLE, "$dmsetup table -j $major -m $minor 2>/dev/null|") or
		return undef;
	while (<HANDLE>) {
		if (!(/^(\d+)\s+(\d+)\s+(\S+)\s+(\S.*)$/)) {
			die("Error: Unrecognized device-mapper table format ".
			    "for device '$dev_name'\n");
		}
		my ($start, $length, $target_type, $args) = ($1, $2, $3, $4);
		my $data;
		my $type;

		if ($target_type eq "linear") {
			$type = $TARGET_TYPE_LINEAR;
			$data = get_linear_data($dev_name, $args);
		} elsif ($target_type eq "mirror") {
			$type = $TARGET_TYPE_MIRROR;
			$data = get_mirror_data($dev_name, $args);
		} elsif ($target_type eq "multipath") {
			$type = $TARGET_TYPE_MULTIPATH;
			$data = get_multipath_data($dev_name, $args);
		} else {
			die("Error: Unsupported setup: Unsupported ".
			    "device-mapper target type '$target_type' for ".
			    "device '$dev_name'\n");
		}
		push(@table, [$start, $length, $type, $data]);
	}
	close(HANDLE);
	return \@table;
}

# get_linear_data(dev_name, args)
# Returns: [major, minor, start_sector]
sub get_linear_data($$)
{
	my ($dev_name, $args) = @_;

	if (!($args =~ /^(\d+):(\d+)\s+(\d+)$/)) {
		die("Error: Unrecognized device-mapper table format for ".
		    "device '$dev_name'\n");
	}
	return [$1, $2, $3];
}

# get_mirror_data(dev_name, args)
# Returns [[major1, minor1, start_sector1], [major2, minor2, start_sector2], ..]
sub get_mirror_data($$)
{
	my ($dev_name, $args) = @_;
	my @argv = split(/\s+/, $args);
	my @data;
	my $offset;
	my $num;

	# Remove log_type + #logargs + logargs
	splice(@argv, 0, $argv[1] + 2);
	if (!@argv) {
		goto out_error;
	}
	$num = shift(@argv);
	while ($num-- > 0) {
		if (!($argv[0] =~ /^(\d+):(\d+)$/)) {
			goto out_error;
		}
		push(@data, [$1, $2, $argv[1]]);
		if (!defined($offset)) {
			$offset = $argv[1];
		} elsif ($argv[1] != $offset) {
			die("Error: Unsupported setup: Mirror target on ".
			    "device '$dev_name' contains entries with varying ".
			    "sector offsets\n");
		}
		splice(@argv, 0, 2);
	}
	if (!scalar(@data)) {
		goto out_error;
	}
	return \@data;

out_error:
	die("Error: Unrecognized device-mapper table format for device ".
	    "'$dev_name'\n");
}

# get_multipath_status(device)
# Return map of nodes to F/A flags (i.e. $map{$node} is either "A" or "F").
# See linux/drivers/md/dm-mpath.c:multipath_status for details.
sub get_multipath_status($)
{
	my $dev = shift();
	my %map;
	my $str;
	my $failed = 0;

	open(my $fh, "$dmsetup status /dev/$dev 2>/dev/null|") or return undef;
	while ($str = <$fh>) {
		# sample output (single line):
		# 0 67108864 multipath \
		# 	2 0 0 \
		#	0 \
		#	2 2 \
		#		E 0 \
		#		2 2 \
		#			8:16 F 1 \
		#				0 1 \
		#			8:0 F 1 \
		#				0 1 \
		#		A 0 \
		#		2 2 \
		#			8:32 A 0 \
		#				0 1 \
		#			8:48 A 0 \
		#				0 1
		my @line = split(/\s+/, $str);
		next if !@line;

		my ($start, $length, $type) = splice(@line, 0, 3);
		next if $type ne "multipath";

		my $cnt = shift(@line); # Remove #multipath_feature_args +
		splice(@line, 0, $cnt) if $cnt > 0; # multipath_feature_args

		$cnt = shift(@line); # Remove #handler_status_args +
		splice(@line, 0, $cnt) if $cnt > 0; # handler_status_args

		# num_groups init_group_number ...
		my ($ngr, $ign) = splice(@line, 0, 2);
		for (my $g = 0; $g < $ngr; $g++) {
			# Remove group_state + #ps_status_args
			# group_state: D(isabled), A(ctive), or E(nabled)
			my ($state, $cnt) = splice(@line, 0, 2);
			# Remove ps_status_args*
			splice(@line, 0, $cnt) if $cnt > 0;
			# Remove #paths + #selector_args
			my ($paths, $nsa) = splice(@line, 0, 2);
			for (my $p = 0; $p < $paths; $p++) {
				# Fetch single path description
				my ($node, $active, $fail_cnt)
					= splice(@line, 0, 3);
				# active: A(ctive) or F(ailed)
				$map{$node} = $active;
				$failed++ if $active ne "A";
				# Remove selector_args*
				splice(@line, 0, $nsa) if $nsa > 0;
			}
		}
	}
	close($fh);

	die ("Error: No paths found for '$dev'\n") if scalar(keys %map) == 0;
	if ($failed) {
		die ("Error: All paths for '$dev' failed\n")
			if $failed == scalar(keys %map);

		print(STDERR "Warning: There are one or more failed paths for"
			." device '$dev'\n");
	}
	return \%map;
}

# get_multipath_data(dev_name, args)
# Returns [[major1, minor1], [major2, minor2], ..]
sub get_multipath_data($$)
{
	my ($dev_name, $args) = @_;
	my $status = get_multipath_status($dev_name);
	my @argv = split(/\s+/, $args);
	my @data;

	# Remove #features + features
	splice(@argv, 0, $argv[0] + 1);
	if (!@argv) {
		goto out_error;
	}
	# Remove #handlerargs + handlerargs
	splice(@argv, 0, $argv[0] + 1);
	if (!@argv) {
		goto out_error;
	}
	# Remove #pathgroups + pathgroup
	splice(@argv, 0, 2);
	while (@argv) {
		# Remove pathselector + #selectorargs + selectorargs
		splice(@argv, 0, 2 + $argv[1]);
		if (!@argv) {
			goto out_error;
		}
		my $num_paths = $argv[0];
		my $num_path_args = $argv[1];
		# Remove #paths + #pathargs
		splice(@argv, 0, 2);
		while ($num_paths-- > 0) {
			if (!@argv) {
				goto out_error;
			}
			if (!($argv[0] =~ /(\d+):(\d+)/)) {
				goto out_error;
			}
			push(@data, [$1, $2]) if $status->{$argv[0]} eq "A";
			# Remove device + deviceargs
			splice(@argv, 0, 1 + $num_path_args);
		}
	}
	if (!@data) {
		goto out_error;
	}
	return \@data;

out_error:
	die("Error: Unrecognized device-mapper table format for device ".
	    "'$dev_name'\n");
}

# filter_table(table, start, length)
# Returns table containing only targets between start and start + length - 1.
sub filter_table($$$)
{
	my ($table, $start, $length) = @_;
	my $end = $start + $length - 1;
	my @result;
	my $target;

	foreach $target (@$table) {
		my $target_start = $target->[$TARGET_START];
		my $target_end = $target_start + $target->[$TARGET_LENGTH] - 1;

		if (!(($target_end < $start) || ($target_start > $end))) {
			push(@result, $target);
		}
	}
	return \@result;
}

# get_target_start(target)
# Returns the start sector of target.
sub get_target_start($)
{
	my ($target) = @_;
	my $type = $target->[$TARGET_TYPE];
	my $data = $target->[$TARGET_DATA];

	if ($type == $TARGET_TYPE_LINEAR) {
		return $data->[$LINEAR_START_SECTOR];
	} elsif ($type == $TARGET_TYPE_MIRROR) {
		my $mirror_data = $data->[0];
		return $mirror_data->[$MIRROR_START_SECTOR];
	} else {
		return 0;
	}
}

# get_target_major_minor(target)
# Returns (major, minor) of target of target.
sub get_target_major_minor($)
{
	my ($target) = @_;
	my $type = $target->[$TARGET_TYPE];
	my $data = $target->[$TARGET_DATA];
	my $major;
	my $minor;

	if ($type == $TARGET_TYPE_LINEAR) {
		$major = $data->[$LINEAR_MAJOR];
		$minor = $data->[$LINEAR_MINOR];
	} elsif ($type == $TARGET_TYPE_MIRROR) {
		# Use data of first device in list
		my $mirror_data = $data->[0];
		$major = $mirror_data->[$MIRROR_MAJOR];
		$minor = $mirror_data->[$MIRROR_MINOR];
	} elsif ($type == $TARGET_TYPE_MULTIPATH) {
		# Use data of first device in list
		my $multipath_data = $data->[0];
		$major = $multipath_data->[$MULTIPATH_MAJOR];
		$minor = $multipath_data->[$MULTIPATH_MINOR];
	}
	return ($major, $minor);
}

# create_temp_device_node(type, major, minor)
# Returns the name of a temporary device node.
sub create_temp_device_node($$$)
{
	my ($type, $major, $minor) = @_;
	my $path = "/dev";
	my $name;
	my $num;

	for ($num = 0; $num < 100; $num++) {
		$name = sprintf("$path/zipl-dm-temp-%02d", $num);
		if (-e $name) {
			next;
		}
		if (system("$mknod $name $type $major $minor --mode 0600 ".
			   "2>/dev/null")) {
			next;
		}
		return $name;
	}
	die("Error: Could not create temporary device node in '$path'\n");
}

# get_blocksize(device)
# # Return blocksize in bytes for device.
sub get_blocksize($)
{
	my ($dev) = @_;
	my $blocksize;
	local *HANDLE;

	open(HANDLE, "$blockdev --getss $dev 2>/dev/null|") or
		return undef;
	$blocksize = <HANDLE>;
	chomp($blocksize);
	close(HANDLE);

	return $blocksize;
}

# get_dasd_info(device)
# Returns (type, cylinders, heads, sectors)
sub get_dasd_info($)
{
	my ($dev) = @_;
	my $disk_type;
	my $format;
	my $cyl;
	my $heads;
	my $sectors;
	my $type;
	local *HANDLE;

	open(HANDLE, "$dasdview -x $dev 2>/dev/null|") or
		# dasdview returned with an error
		return undef;
	while (<HANDLE>) {
		if (/^number of cylinders.*\s(\d+)\s*$/) {
			$cyl = $1;
		} elsif (/^tracks per cylinder.*\s(\d+)\s*$/) {
			$heads = $1;
		} elsif (/^blocks per track.*\s(\d+)\s*$/) {
			$sectors = $1;
		} elsif (/^type\s+:\s+(\S+)\s*$/) {
			$disk_type = $1;
		} elsif (/^format.*\s+dec\s(\d+)\s/) {
			$format = $1;
		}
	}
	close(HANDLE);
	if (!defined($cyl) || !defined($heads) || !defined($sectors) ||
	    !defined($disk_type) || !defined($format)) {
		# Unrecognized dadsview output format
		return undef;
	}
	if ($disk_type eq "FBA") {
		$type = $DEV_TYPE_FBA;
	} elsif ($disk_type eq "ECKD") {
		if ($format == 1) {
			$type = $DEV_TYPE_LDL;
		} elsif ($format == 2) {
			$type = $DEV_TYPE_CDL;
		}
	}

	return ($type, $cyl, $heads, $sectors);
}

# get_partition_start(major, minor)
# Return the partition offset of device.
sub get_partition_start($$)
{
	my ($major, $minor) = @_;
	my $dir = "/sys/dev/block/$major:$minor";
	my $offset;
	local *HANDLE;

	return undef if (!-d $dir);

	open(HANDLE, "<", "$dir/start") or return 0;
	$offset = <HANDLE>;
	close(HANDLE);

	chomp($offset);

	return $offset;
}

# is_dasd(type)
# Return whether disk with type is a DASD.
sub is_dasd($)
{
	my ($type) = @_;

	return ($type == $DEV_TYPE_CDL) || ($type == $DEV_TYPE_LDL) ||
	       ($type == $DEV_TYPE_FBA);
}

# get_partition_base(type, major, minor)
# Return (major, minor) of the base device on which the partition is located.
sub get_partition_base($$$)
{
	my ($type, $major, $minor) = @_;

	if (is_dasd($type)) {
		return ($major, $minor & ~$DASD_PARTN_MASK);
	} else {
		return ($major, $minor & ~$SCSI_PARTN_MASK);
	}
}

# get_device_characteristics(major, minor)
# Returns (type, blocksize, geometry, bootsectors, partstart) for device.
sub get_device_characteristics($$)
{
	my ($major, $minor) = @_;
	my $dev;
	my $blocksize;
	my $type;
	my $cyl;
	my $heads;
	my $sectors;
	my $geometry;
	my $bootsectors;
	my $partstart;

	$dev = create_temp_device_node("b", $major, $minor);
	$blocksize = get_blocksize($dev);
	if (!defined($blocksize)) {
		unlink($dev);
		die("Error: Could not get block size for ".
		    get_device_name($major, $minor)."\n");
	}
	($type, $cyl, $heads, $sectors) = get_dasd_info($dev);
	if (defined($type)) {
		$geometry = "$cyl,$heads,$sectors";
		if ($type == $DEV_TYPE_CDL) {
			# First track contains IPL records
			$bootsectors = $blocksize * $sectors / $SECTOR_SIZE;
		} elsif ($type == $DEV_TYPE_LDL) {
			# First two blocks contain IPL records
			$bootsectors = $blocksize * 2 / $SECTOR_SIZE;
		} elsif ($type == $DEV_TYPE_FBA) {
			# First block contains IPL records
			$bootsectors = $blocksize / $SECTOR_SIZE;
		}
	} else {
		# Assume SCSI if get_dasd_info failed
		$type = $DEV_TYPE_SCSI;
		# First block contains IPL records
		$bootsectors = $blocksize / $SECTOR_SIZE;
	}
	$partstart = get_partition_start($major, $minor);
	unlink($dev);
	if (!defined($partstart)) {
		die("Error: Could not determine partition start for ".
		    get_device_name($major, $minor)."\n");
	}
	# Convert partition start in sectors to blocks
	$partstart = $partstart / ($blocksize / $SECTOR_SIZE);
	return ($type, $blocksize, $geometry, $bootsectors, $partstart);
}

# get_type_name(type)
# Return textual representation of device type.
sub get_type_name($)
{
	my ($type) = @_;

	if ($type == $DEV_TYPE_CDL) {
		return "CDL";
	} elsif ($type == $DEV_TYPE_LDL) {
		return "LDL";
	} elsif ($type == $DEV_TYPE_FBA) {
		return "FBA";
	} elsif ($type == $DEV_TYPE_SCSI) {
		return "SCSI";
	}
	return undef;
}


# check_for_mirror(index, target_list)
# Die if there is a mirror target between index and 0.
sub check_for_mirror($@)
{
	my ($i, @target_list) = @_;

	for (;$i >= 0; $i--) {
		my $entry = $target_list[$i];
		my ($major, $minor, $target) = @$entry;

		if ($target->[$TARGET_TYPE] == $TARGET_TYPE_MIRROR) {
			# IPL records are not mirrored.
			die("Error: Unsupported setup: Block 0 is not ".
			    "mirrored in device '".
			    get_device_name($major, $minor)."'\n");
		}
	}
}

# get_target_base(bottom_major, bottom_minor, start, length, target_list)
# Return (major, minor) for the top most target in the target list that maps
# the region on (bottom_major, bottom_minor) defined by start and length at
# offset 0.
sub get_target_base($$$$@)
{
	my ($bot_major, $bot_minor, $start, $length, @target_list) = @_;
	my $entry;
	my $top_major;
	my $top_minor;
	my $i;

	# Pre-initialize with bottom major-minor
	$top_major = $bot_major;
	$top_minor = $bot_minor;
	# Process all entries starting with the last one
	for ($i = scalar(@target_list) - 1; $i >= 0; $i--) {
		my $entry = $target_list[$i];
		my ($major, $minor, $target) = @$entry;

		if (($target->[$TARGET_START] != 0) ||
		    (get_target_start($target) != 0) ||
		    ($target->[$TARGET_LENGTH] < $length)) {
			last;
		}
		$top_major = $major;
		$top_minor = $minor;
	}
	# Check for mirrorring between base device and fs device.
	check_for_mirror($i, @target_list);
	return ($top_major, $top_minor);
}

# get_device_name(major, minor)
# Return the name of the device specified by major and minor.
sub get_device_name($$)
{
	my ($major, $minor) = @_;
	my $name;
	local *HANDLE;

	$name = "$major:$minor";
	open(HANDLE, "</proc/partitions") or goto out;
	while (<HANDLE>) {
		if (/^\s*(\d+)\s+(\d+)\s+\d+\s+(\S+)\s*$/) {
			if (($major == $1) && ($minor == $2)) {
				$name = $3;
				last;
			}
		}
	}
	close(HANDLE);
out:
	return $name;
}

sub check_tools()
{
system("$dmsetup --version &> /dev/null") >> 8 != 127
    or die("Error: dmsetup not found\n");
system("$mknod --version &> /dev/null") >> 8 != 127
    or die("Error: mknod not found\n");
system("$dasdview --version &> /dev/null") >> 8 != 127
    or die("Error: dasdview not found\n");
system("$blockdev --version &> /dev/null") >> 8 != 127
    or die("Error: blockdev not found\n");

return 0;
}