#!/usr/bin/perl -w
use strict;
use Text::Wrap;
use Cwd 'abs_path';

#
# PING (PING Is Not Ghost) / rc.ping
#
# Copyright(c) 2005 to 2015 EFFITEK
# Home page: PING (PING Is Not Ghost) http://ping.windowsdream.com/
#
# This script is intended to run on a PING Linux-live image. As for PING,
# Linux, GNU/GPL tools, etc. refer to specific licences.
# This script (rc.ping) has been written by Fabrice SCEMAMA (the Author),
# from Windowsdream.com. Email: natan@windowsdream.com .
#
# * Use it at your own risk. No warranty, no damage accountability.
# * Please, refer any bug / feature request to the Author.
#

$Text::Wrap::columns = 72;

my $MYSELF = "rc.ping";
my $PRODUCT_NAME = "PING (PING Is Not Ghost)";
my $VERSION = "4.00.008";
my $VERSION_DATE = "2016-01-07";
my $VERSION_LINUX = `uname -s -n -r -m -p -i -o`;
$VERSION_LINUX =~s/\s*$//;
my $PING_DIR = "/opt/PING";

my %P = ();
my %Target_Device = ();    # For ADT() to remember

my $TIP_SLEEP = 2;
my $PARTIMAGE_SLEEP = 2;
my $README_SLEEP = 7;
my $FAILED_SLEEP = 10;
my $INFO_SLEEP = 4;

my $DD_SPLIT = 660600000;
my $PARTCLONE_SPLIT = 660600000;
my $PARTIMAGE_SPLIT = 630;
my $ZSPLIT_SPLIT = 630;
my $FSARCHIVER_SPLIT = 630;

my $NTFS_MNT = "mount -t ntfs-3g";
my $NTFS_MNT_TYPE = "ntfs-3g";

my $HELP_DELL = "";
my $GLOBAL_ACTION = "";

my $TMPDIR = "/tmp";
my $PING_CONF = "/etc/ping.conf";
my $LOG_PATH = "/var/log/ping.log";


# Preliminaries
# We may use a RO squashfs... so, a tmpfs may be needed too
#
if(-e "/mnt/tmp")
{
    $TMPDIR = "/mnt/tmp";
    unless(Is_Mounted($TMPDIR))
    {
        system("mount -n tmpfs -t tmpfs ".$TMPDIR);
    }
}
if(-e $LOG_PATH.".gz")
{
    unlink($LOG_PATH.".gz");
}
if(-e $LOG_PATH)
{
    system("gzip -9 ".$LOG_PATH);
}

LOG("---------------------------------------------------\n");
LOG("* Starting [".$MYSELF."] [".$VERSION."] [".$VERSION_DATE."]\n");
LOG("* Linux version: [".$VERSION_LINUX."]\n");
LOG("*\n");


# Get info from a config file, if any.
#
LOG("* Looking for a possible [".$PING_CONF."] file...\n");
LOG("  or for arguments passed to the kernel at boot time\n");

my(@CONFIG_FIELDS) = ("IP", "Netmask", "Gateway", "DHCP_Timeout",
		      "Server", "Share", "User", "Passwd", "Directory",
		      "Image_To_Restore", "Minimize_Before_Storing",
		      "Repart", "After_Completion", "Replace_BIOS",
		      "CIFS_Preferred", "Zsplit_Preferred", "Partclone_Preferred",
		      "Tarball_Preferred", "No_Shell",
		      "AUTO", "Cmd_1", "Cmd_2", "Cmd_3", "Restore_Only",
		      "Compression_Type", "NFS_Preferred", "FTP_Preferred",
		      "Its_HDA_Stupid", "Force_Dirty_NTFS_Mount",
		      "Extend_Parts_Whenever_Possible", "Dont_Warn_Me",
		      "Store_MD5", "New_Image_Name", "Parts_To_Backup",
		      "Already_Existing_Image", "Verbosity",
		      "Unique_Message", "Suppress_RootSys_Files");

{
    my $flag = 0;

    if(-e $PING_CONF)
    {
	LOG("  Found a [".$PING_CONF."] file.\n");

	$flag = Get_Parameters($PING_CONF, \@CONFIG_FIELDS, \%P);

	if(-e "/proc/cmdline")
	{
	    LOG("  Parsing the [/proc/cmdline] file for arguments possibly\n");
	    LOG("    passed to the kernel\n");

	    open(DB, "/proc/cmdline");
	    while(<DB>)
	    {
		s/^\s*//;
		s/\s*$//;
		while(m/\"([^\"]+)\"/)
		{
		    my $tmp = $1;
		    $tmp =~s/\s/£££/g;
		    s/\"([^\"]+)\"/$tmp/;
		}
		my(@Params) = split(/ /, $_);

		foreach my $Param (@Params)
		{
		    $Param =~s/£££/ /g;
		    my(@fields) = split(/=/, $Param);
		    if($#fields > 0)
		    {
			my $Key = $fields[0];
			my $Value = join("=", @fields[1..$#fields]);

			foreach(@CONFIG_FIELDS)
			{
			    if(lc($_) eq lc($Key))
			    {
				$P{$_} = $Value;
				$flag = 1;
			    }
			}
		    }
		}
	    }
	    close(DB);
	}

	foreach(@CONFIG_FIELDS)
	{
	    if(defined($P{$_}))
	    {
		LOG("  Param: [".$_."] = [".((m/^Passwd$/) ? "xxx":$P{$_})."]\n");
	    }
	}
    }

    unless($flag)
    {
	LOG("  No preconfiguration was found. Not a problem.\n\n");
	LOG("  TIP: by adding a ping.conf to the linux image,\n");
	LOG("       or by passing'key=value' arguments to the\n");
	LOG("       kernel ((iso|pxe)linux.cfg), you could avoid\n");
	LOG("       having to type again and again the same net/smb\n");
	LOG("       settings. Visit the forum for more information.\n\n");
	sleep($TIP_SLEEP);
    }
}


# Feed now all possible -- well, most -- /dev devices related to disk-storage.
# Source: http://www.lanana.org/docs/device-list/devices.txt
#
my(@ALPH) = ('a','b','c','d','e','f','g','h','i','j','k','l','m',
	     'n','o','p','q','r','s','t','u','v','w','x','y','z');

my(%DEV_NODES) = ();

Feed_Dev_Nodes();


# The source. Where the images will be found.
#
my $SRC = "";


# Installs every available module (some drivers cannot be statically
# linked to the kernel).
#
LOG("* Scanning for modules to install...\n");
{
    my(@Modules) = `find /lib/modules/\`uname -r\` |grep \\.ko\$`;
    foreach(@Modules)
    {
	s/\s*$//;
	Exec_Log("insmod $_", 2, "", 0);
    }
}


# Log the hardware config as seen by the kernel for reviewing.
#
LOG("* Keep the dmesg log for review and debugging\n");
{
    my $out = `dmesg 2>&1`;
    my(@lines) = split(/\n/, $out);
    foreach(@lines)
    {
	LOG(  $_."\n");
    }
}


# Try to mount the CDRom and find there an image.
#
LOG("* Looking for a possible CD/DVD...\n");
LOG("  Expect some warnings to appear\n");

my $CD_Dev = '';
{
    my $nb = 0;
    foreach my $d ("hda", "hdb", "hdc", "hdd", "hde", "hdf", "hdg", "hdh", "hdi",
		   "hdj", "hdk", "hdl", "sda", "sdb", "sdc", "sdd", "sde", "sdf",
		   "sdg", "sdh", "sdi", "sdj", "sdk", "sdl", "sr0", "sr1", "sr2")
    {
	Umount("/mnt/cdrom");
        system("mount /dev/".$d." /mnt/cdrom >/dev/null 2>&1");
        my $nb = `df|grep cdrom|wc -l`;
        if($nb > 0)
	{
            LOG("  Found and mounted a CDRom\n");
            opendir(DIR, "/mnt/cdrom");
            my(@Files) = readdir(DIR);
            closedir(DIR);
            foreach my $F (@Files)
	    {
		if($F =~/[hs]d[abcdef]$/
		   || $F =~/(cciss|rd|ida|mapper)\/c\d{1}d\d{1,2}$/
		   || $F =~/md\d+$/
		   || $F =~/askme_[abcdef]$/i
		   || $F =~/^addon(\-|_).*\.tar\.(gz|bz2|xz)/i
		   || $F =~/^addon(\-|_).*\.zip/i)
		{
                    LOG("  Found a [/mnt/cdrom/".$F."] file\n");
		    $CD_Dev = $d;
                    $SRC = "/mnt/cdrom";
		    LOG("  Linking [/dev/cdrom] to [/dev/".$d."]\n");
		    if(-e "/dev/cdrom")
		    {
			LOG("    Deleting an old [/dev/cdrom]\n");
			unlink("/dev/cdrom");
		    }
		    Exec_Log("ln -sf /dev/".$d." /dev/cdrom", 4);
                }
            }
            sleep(3);   # Blink & start up.
            last;
        }
    }
    unless($nb)
    {
        LOG("  No CDRom device or media was found.\n");
    }
}


# If addon*.tar.gz/.zip/.xz files have been added to the cdrom,
# they can be untarred to the root of the system now.
#
LOG("* Looking for any addon in the CD/DVD...\n");
{
    opendir(DIR, "/mnt/cdrom");
    my(@files) = readdir(DIR);
    closedir(DIR);
    foreach(@files)
    {
	if(m/^addon(\-|_).*\.tar\.(gz|bz2|xz)/i || m/^addon(\-|_).*\.zip/i)
	{
	    LOG("  Addon found! [".$_."]\n");
	    Exec_Log("cd /; ".Unzip("/mnt/cdrom/".$_), 4);
	}
    }
}


# Give a last tip if a CD/DVD with an image on it has been found.
#
if($SRC =~/cdrom/i)
{
    LOG("  TIP: by setting an AUTO parameter to Y,\n");
    LOG("       you can have the restoration process go\n");
    LOG("       with strictly no user interaction. Go to the\n");
    LOG("       forum for more information or refer to the HOWTO.\n\n");
    sleep($TIP_SLEEP);
}


# Defaults some ping.conf options
#
unless(defined($P{Verbosity}) && $P{Verbosity} =~/^[012]$/)
{
    $P{Verbosity} = 2;
}
unless(defined($P{Unique_Message}))
{
    $P{Unique_Message} = "";
}

unless(defined($P{No_Shell}))
{
    $P{No_Shell} = 0;
}

unless(defined($P{Restore_Only}))
{
    $P{Restore_Only} = 0;
}

unless(defined($P{Dont_Warn_Me}))
{
    $P{Dont_Warn_Me} = 0;
}

if(! defined($P{DHCP_Timeout}) || $P{DHCP_Timeout} =~/\D/)
{
    $P{DHCP_Timeout} = 0;
}

unless(defined($P{Image_To_Restore}))
{
    $P{Image_To_Restore} = "";
}


# Give the user a chance to avoid this script.
#
system("clear");

Show_Logo();

print "\n";
print "\n".$VERSION_LINUX."\n";
print "\n***         ".$PRODUCT_NAME." --- ".$VERSION." ".$VERSION_DATE."           ***\n";
print "***            Get doc and latest release on PING website              ***\n";
print "***                   http://ping.windowsdream.com/                    ***\n";
print "***                                                                    ***\n";
print "***     PING is brought to you by EFFITEK -- http://www.effitek.fr     ***\n";
unless(YES($P{No_Shell}))
{
    print "\n";
    print ">> Type [ENTER] to go on with the PING interface, or x to get a shell   <<\n";
    print ">> (login as root, no passwd needed). Type h to get basic shell help.   <<\n";
    print "\n";
    print ">> If you want to be able to switch between terminals (Alt-F2, Alt-F3,  <<\n";
    print ">> etc.), then type x, get a shell, and launch PING yourself with the   <<\n";
    print ">> /opt/PING/rc.ping command.                                           <<\n";
}
print "\n>> ";


# If a CD/DVD/USB device has been booted, raise no question if a file
# called 'AUTO' (case-sensitive) is found on the root of the CD/DVD/USB dev.
#
# This method is deprecated, and we ensure backward compatibility here.
#
if($SRC =~/cdrom/ && -e "/mnt/cdrom/AUTO")
{
    LOG("* /cdrom/AUTO file found! No exit possibility given to the user.\n");
    $P{AUTO} = 1;
}

unless(defined($P{AUTO}) && $P{AUTO})
{
    my $Grab = <STDIN>;
    if($Grab =~/^h/i && ! YES($P{No_Shell}))
    {
	Print_Shell_Help();
	print "\n>> ";
	$Grab = <STDIN>;
    }
    if($Grab =~/^skip/i)
    {
	LOG("* Skip keyword! Erasing all data passed from kernel params/ping.conf\n");
	%P = ();
    }
    if($Grab =~/^x/i && ! YES($P{No_Shell}))
    {
	exit;
    }
}


# Check for needed binaries in the OS.
#
LOG("* Check for needed binaries...\n");

foreach('fdisk', 'sfdisk', 'dialog', 'sleep', 'kill', 'cut', 'sed',
	'mount', 'grep', 'curlftpfs', 'partimage', 'zsplit', 'chntpw',
	'dd', 'echo', 'cmospwd', 'ntfsresize', 'swapoff', 'swapon',
	'df', 'parted', 'resize2fs', 'uname', 'find', 'wc', 'rm',
	'chmod', 'ps', 'tail', 'route', 'ifconfig', 'free', 'ntfslabel',
	'star', 'tar', 'gzip', 'bzip2', '7za', 'unzip', 'md5sum',
	'tail', 'vgscan', 'vgchange', 'dmraid', 'mdadm', 'partclone.btrfs',
	'partclone.ext4', 'partclone.reiser4', 'partclone.reiserfs',
	'partclone.vmfs', 'partclone.xfs', 'blockdev', 'fsarchiver')
{
    unless(-e $_ || Is_In_Path($_))
    {
	LOG("    !!! [".$_."] not found\n");
	LOG("        Your image is probably corrupt. Aborting now.\n");
	sleep($FAILED_SLEEP);
	Quit();
    }
}

LOG("  OK, everybody's here.\n");


# Give Fakeraids a chance to be detected.
#
LOG("* Build fakeraid /dev/md* devices, if any\n");
my(@RAID_Members) = ();
Build_Fakeraids(\@RAID_Members);


# Try to find all HDD devices / will be useful or not, according
# to the user's choice, but it's (almost) costless to explore.
#
LOG("* Exploring local disk drives\n");

my @Dev = ();
{
    my @AllDevices = ('hda', 'hdb', 'hdc', 'hdd',
		      'sda', 'sdb', 'sdc', 'sdd', 'sde', 'sdf');

    # Generate all possible cciss hard disk device names and push them into AllDevices
    # (Compaq HP SmartArray). Same for RAID devices (ida and rd).
    #
    for(my $i = 0; $i <= 7; $i++) 
    {
	for(my $j = 0; $j <= 15; $j++)
	{
	    push(@AllDevices, "cciss/c".$i."d".$j);
	    push(@AllDevices, "ida/c".$i."d".$j);
	    push(@AllDevices, "rd/c".$i."d".$j);
	}
    }

    # Add what fdisk may see
    #   Disk /dev/sda: 42.9 GB, 42949672960 bytes
    #   Disk /dev/sdb: 322.1 GB, 322122547200 bytes
    #
    my $cmd = "fdisk -l|grep -i Disk|grep -v identifier|grep -v -i disklabel"
	."|grep -v -i \/ram|grep -v \/dev\/mapper 2>&1";
    LOG("  Cmd: [".$cmd."]\n");
    my $out = `$cmd`;
    LOG("  Out: [".$out."]\n");
    my(@lines) = split(/\n/, $out);
    foreach my $d (@lines)
    {
	$d =~s/^\s*Disk\s*//;
	$d =~s/:.*$//;
	$d =~s/\/dev\///;
	if($d)
	{
	    LOG("    Device: [".$d."]\n");
	    my $flag = 0;
	    foreach my $A (@AllDevices)
	    {
		if($A eq $d)
		{
		    ++ $flag;
		    last;
		}
	    }
	    unless($flag)
	    {
		push(@AllDevices, $d);
	    }
	}
    }

    # Add possible /dev/md* devices (fakeraid)
    # Ex.: /dev/md126 and /dev/md126p1
    #
    # cat /proc/mdstat
    # Personalities : [raid1]
    # md126 : active raid1 sdb[0]
    # 1465136128 blocks super external:/md127/0 [2/1] [U_]
    # md127 : inactive sdc[1](S) sdb[0](S)
    #
    LOG("  Querying [/proc/mdstat]\n");
    if(-e "/proc/mdstat")
    {
	open(DB, "/proc/mdstat");
	while(<DB>)
	{
	    if(m/^md/ && ! m/inactive/ && m/active/)
	    {
		my $device = $_;
		$device =~s/^(md\d+)\D.*$/$1/;
                $device =~s/\s*$//;
		push(@AllDevices, $device);
		LOG("    Added [/dev/".$device."]\n");
	    }
	}
	close(DB);
    }

    foreach(@AllDevices)
    {
	# At least thanks to udev, we won't have too many tries!
	#
	if(-e "/dev/".$_)
	{
	    # Either not a partition at all, either is a CDRom = bad cases
	    #
	    my $out = `fdisk -l /dev/$_ 2>$TMPDIR/out.2`;
	    if(-z $TMPDIR."/out.2" && $out !~/you will not be able to write/i)
	    {
		push(@Dev, $_);
	    }
	    if(-e $TMPDIR."/out.2")
	    {
		unlink($TMPDIR."/out.2");
	    }
	} 
    }
}
foreach(@Dev)
{
    LOG("  => HDD device found: [".$_."]\n");
    sleep(1);
}
if($#Dev < 0)
{
    LOG("\n");
    LOG("  !!! No HDD device could be found. Will do nothing.\n");
    LOG("      This usually means that the current kernel has been\n");
    LOG("      unable to load drivers for your local hard disks to be\n");
    LOG("      mounted. Go to PING Forum and describe your hardware and\n");
    LOG("      the PING release you're using, i.e. [".$VERSION."] [".$VERSION_DATE."].\n");
    LOG("      You can also consider recompiling the kernel yourself, in\n");
    LOG("      which case you'll find our .config file on the Download page.\n\n");
    sleep($FAILED_SLEEP);
    Quit();
}

# And now, exploring each device for parts and parts' types.
# In @Dev, we should have values like hda, hdb, sda, cciss/c0d0, rd/c0d1...
#
# Note concerning cciss/rd/ida: fdisk can send this:
#   Disk /dev/rd/c0d0: 128 heads, 32 sectors, 52069 cylinders
#   Units = cylinders of 4096 * 512 bytes
#
#           Device Boot    Start       End    Blocks   Id  System
#   /dev/rd/c0d0p1             1        26     53232   83  Linux
#   /dev/rd/c0d0p2            27       539   1050624   82  Linux swap
#
LOG("* Exploring each hdd for parts and types\n");

my(@Dev_Rich) = ();
HDD_Discover(\@Dev, \@Dev_Rich, \@RAID_Members);


# If there's any command to execute before interactivity,
# do so now.
#
LOG("* Any command to execute before the welcome screen ?\n");

if(defined($P{Cmd_1}) && $P{Cmd_1})
{
    LOG("  Yes! [".$P{Cmd_1}."]");
    my $out = system($P{Cmd_1});
    LOG("  Output: [".$out."]\n");
}
else
{
    LOG("  No defined command.\n");
}


# Give a warm welcome to the user...
#
if(defined($P{AUTO}) && $P{AUTO})
{
    LOG("* AUTO param set! No warm welcome.\n");
}
else
{
    my $cmd = 'dialog --colors --msgbox "\Zb\Z7Welcome to PING (PING Is'
        .' Not Ghost)!\n\n\n'
        .'\ZnThis tool can be used both to backup a Ghost-like image of'
        .' your hard disk and to restore your hard disk from such an image.'
        .' Please, be aware that if you choose to restore your hard disk,'
        .' ALL the data contained on this computer might be '
        .'lost during the restoration. You may choose to abort now, by '
        .'stopping the computer now.\n\n\n" 22 73';
    system($cmd);
}


# Not everyone would like an automatic reboot to occur at the end of the
# operations... ask before, do later.
#
my $After_Completion = '';

if(defined($P{After_Completion}) && $P{After_Completion} =~/reboot/i)
{
    $After_Completion = "Reboot";
}
elsif(defined($P{After_Completion}) && $P{After_Completion} =~/shell/i)
{
    $After_Completion = "Shell";
}
elsif(defined($P{After_Completion}) && $P{After_Completion} =~/shutdown/i)
{
    $After_Completion = "Shutdown";
}

unless($After_Completion)
{
    if(defined($P{AUTO}) && $P{AUTO})
    {
	LOG("* AUTO param set! Won't offer not to reboot.\n");
    }
    else
    {
	LOG("* Ask whether we'll reboot or exit at the end of the job\n");

	my $SH = '';
	unless(YES($P{No_Shell}))
	{
	    $SH = '"Get a shell (root)" ""';
	}
	my $cmd = 'dialog --colors --menu "\Zb\Z7'.$PRODUCT_NAME.'\n\n'
	    .'\ZnWhen the job is completed, do you want to...\n\n" 15 40 3 '
	    .' '.$SH.' "Reboot the system" ""'
	    .' "Shutdown" "" 2>'.$TMPDIR.'/checklist.tmp';
	system($cmd);

	if(-z $TMPDIR."/checklist.tmp")
	{
	    $After_Completion = "Shell";
	    Quit();
	}

	open(DB, $TMPDIR."/checklist.tmp");
	while(<DB>)
	{
	    if(m/shell/i)
	    {
		$After_Completion = "Shell";
		LOG("  Shell!\n");
		last;
	    }
	    elsif(m/shutdown/i)
	    {
		$After_Completion = "Shutdown";
		LOG("  Shutdown!\n");
		last;
	    }
	    elsif(m/reboot/i)
	    {
		$After_Completion = "Reboot";
		LOG("  Reboot!\n");
		last;
	    }
	}
	close(DB);

	unlink($TMPDIR."/checklist.tmp");
    }
}

LOG("* After Completion: [".$After_Completion."]\n");


# As no CD/DVD is involved, the user may choose whether he wants
# to save/restore to a local part or to the network.
#
unless($SRC)
{
    LOG("* Ask whether operations will be local or network\n");

    if(defined($P{Server}) && $P{Server} !~/^\/dev/)
    {
	LOG("  The user has provided a not-dev Server entry param =>Will be network\n");
    }
    elsif(defined($P{Server}) && $P{Server} =~/^\/dev/)
    {
	LOG("  The user has provided a /dev Server entry in params =>"
	    ."  Will be local\n");
	$P{Server} =~s/\s//g;
	LOG("  Server entry: [".$P{Server}."]\n");
	$SRC = "local";
    }
    else
    {
	LOG("  The user did not provide a Server entry in params => Ask.\n");

	my $cmd = 'dialog --colors --menu "\Zb\Z7'.$PRODUCT_NAME.'\n\n'
	    .'\ZnWhere do you want to save/restore your images to/from ?\n\n" 15 40 2 '
	    .' "Network share" "" "Local disk/partition" "" 2>'.$TMPDIR.'/checklist.tmp';
	system($cmd);

	if(-z $TMPDIR."/checklist.tmp")
	{
	    Quit();
	}

	open(DB, $TMPDIR."/checklist.tmp");
	while(<DB>)
	{
	    if(m/local/i || m/^l/i)
	    {
		$SRC = "local";
		LOG("  Local!\n");
	    }
	    else
	    {
		LOG("  Network!\n");
	    }
	}
	close(DB);

	unlink($TMPDIR."/checklist.tmp");
    }
}


# If there's no CD or CD but no image within the CD and if this is not
# a local backup / restoration, then try the network.
#
unless($SRC)
{
    LOG("\n");
    LOG("* Handling the network connection issue...\n");

    # First, see whether we're already connected to the network.
    # If no, do so. Then, first try DHCP, unless some parameters
    # have been passed to us to fix an IP address.
    #
    LOG("  - Testing the current connection. Do we have an IP ?\n");
    if(! Is_Network_On())
    {
	LOG("    No IP yet.\n");
	if(defined($P{IP}) && $P{IP})
	{
	    LOG("    There are params about the network config. Don't try DHCP.\n");
	}
	else
	{
	    LOG("    No params about the network config. Try DHCP on eth0.\n");
	    Exec_Log("ifconfig eth0 down; ifconfig eth0 up; sleep 2; rm -f"
		     ." /var/run/dhcpcd-eth0.pid; dhcpcd "
		     .($P{DHCP_Timeout} ? "-t ".$P{DHCP_Timeout}:"")." eth0", 4);
	    sleep(2);

	    if(! Is_Network_On())
	    {
		LOG("    ! Could not connect a eth0 NIC to DHCP.\n");
		LOG("    Trying DHCP on eth1.\n");
		Exec_Log("ifconfig eth1 down; ifconfig eth1 up; sleep 2; rm -f"
			 ." /var/run/dhcpcd-eth1.pid; dhcpcd "
			 .($P{DHCP_Timeout} ? "-t ".$P{DHCP_Timeout}:"")." eth1", 4);

		if(! Is_Network_On())
		{
		    LOG("    ! Could not connect a eth1 NIC to DHCP.\n");
		    LOG("    We'll have to ask the user.\n");
		}
	    }
	}
    }
    else
    {
	LOG("    We've already got an IP.\n");
    }

    if(! Is_Network_On())
    {
	LOG("    Still no IP yet. Trying to connect without DHCP.\n");

	my $Tries = 1;

	while($Tries)
	{
	    # Use preconfig parameters if defined.
	    # Set them to nothing if they have been tried unsuccessfully once.
	    #
	    unless($Tries == 1)
	    {
		foreach("IP", "Netmask", "Gateway")
		{
		    $P{$_} = "";
		}
	    }

	    unless(defined($P{IP}) && $P{IP})
	    {
		my $cmd = 'dialog --inputbox "Enter your IP address '
		    .'(eg. 192.168.0.10)" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{IP} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
	    }

	    unless(defined($P{Netmask}) && $P{Netmask})
	    {
		my $cmd = 'dialog --inputbox "Enter your netmask '
		    .'(eg. 255.255.255.0)" 8 51 "255.255.255.0" 2>'.$TMPDIR.'/BLA';
		system($cmd);
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{Netmask} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
	    }

	    unless(defined($P{Gateway}) && $P{Gateway})
	    {
		my $cmd = 'dialog --inputbox "Enter your gateway '
		    .'(eg. 192.168.0.1)" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{Gateway} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
	    }

	    foreach("IP", "Netmask", "Gateway")
	    {
		$P{$_} =~s/^\s*//;
		$P{$_} =~s/\s*$//;
		$P{$_} =~s/[^0-9.]//g;
	    }

	    LOG("    Connecting to the network...\n");

	    LOG("      Trying eth0 first\n");

	    my $out =
		Exec_Log("ifconfig eth0 down;"
			 ." ifconfig eth0 ".$P{IP}." netmask ".$P{Netmask}." up;"
			 ." route add default gw ".$P{Gateway}.";"
			 ." ifconfig eth0", 6);

	    ++ $Tries;

	    if($out =~/$P{IP}/)
	    {
		$Tries = 0;
		LOG("\n");
		LOG("      We're connected! Hurrah! (1)\n");
		sleep($INFO_SLEEP);
	    }

	    unless($Tries == 0)
	    {
		LOG("      Trying eth1 now\n");

		my $out =
		    Exec_Log("ifconfig eth1 down;"
			     ." ifconfig eth1 ".$P{IP}." netmask ".$P{Netmask}." up;"
			     ." route add default gw ".$P{Gateway}.";"
			     ." ifconfig eth1", 6);

		++ $Tries;

		if($out =~/$P{IP}/)
		{
		    $Tries = 0;
		    LOG("\n");
		    LOG("      We're connected! Hurrah! (2)\n");
		    sleep($INFO_SLEEP);
		}
	    }

	    if($Tries)
	    {
		LOG("\n    Command output: [".$out."]\n");
		LOG("\n    BAD network parameters or device/driver pb. TRY AGAIN.\n");
		sleep($README_SLEEP);
	    }
	}
    }
    else
    {
	LOG("\n");
	LOG("    We're connected! Hurrah! (3)\n");
	sleep($INFO_SLEEP);
    }

    $SRC = "/mnt/smbfs";
}


# The user might have already mapped the /mnt/smbfs directory through
# addon scripts or a Cmd_1 parameter (for example, to use sshfs).
# We must detect this case and not interfere if the dir is mapped.
#
my $Is_Smbfs_Mounted = 0;

if($SRC =~/smbfs$/)
{
    LOG("* Make sure the [/mnt/smbfs] directory has not been already mounted\n");
    if(Is_Mounted("/mnt/smbfs"))
    {
	++ $Is_Smbfs_Mounted;
	LOG("  Seems mounted!\n");
    }
    else
    {
	LOG("  Doesn't seem to be mounted.\n");
    }
}


# If network will be used, we should know whether we'll prefer SMBFS,
# CIFS, or even forget samba and use NFS.
#
if($SRC =~/smbfs$/ && ! $Is_Smbfs_Mounted)
{
    LOG("* Will we rather use SMBFS, CIFS, NFS or FTP ?\n");

    if(defined($P{NFS_Preferred}))
    {
	LOG("  There's a preconfig NFS_Preferred entry; worth [".$P{NFS_Preferred}."]\n");
    }
    elsif(defined($P{FTP_Preferred}))
    {
	LOG("  There's a preconfig FTP_Preferred entry; worth [".$P{FTP_Preferred}."]\n");
    }
    elsif(defined($P{CIFS_Preferred}))
    {
	LOG("  There's a preconfig CIFS_Preferred entry; worth [".$P{CIFS_Preferred}."]\n");
    }
    else
    {
	LOG("  There's no preconfig predefined info. Asking.\n");
	
	my $cmd = 'dialog --colors --menu "\Zb\ZnWill we map a network share'
	    .' with Samba CIFS, NFS, or FTP (MS Share: use CIFS) ?'
	    .'\n\n" 12 52 4 "CIFS" "" "NFS" ""'
	    .' "FTP (NO image creation)" "" 2>'.$TMPDIR.'/checklist.tmp';
	system($cmd);

	if(-z $TMPDIR."/checklist.tmp")
	{
	    Quit();
	}

	foreach("CIFS", "NFS", "FTP")
	{
	    $P{$_."_Preferred"} = 0;
	}
	open(DB, $TMPDIR."/checklist.tmp");
	while(<DB>)
	{
	    if(m/CIFS/i) { $P{CIFS_Preferred} = 1; last; }
	    if(m/NFS/i)  { $P{NFS_Preferred} = 1;  last; }
	    if(m/FTP/i)  { $P{FTP_Preferred} = 1;  last; }
	}
	close(DB);
	unlink($TMPDIR."/checklist.tmp");

	foreach("CIFS", "NFS", "FTP")
	{
	    LOG("  =>".$_."_Preferred: [".$P{$_."_Preferred"}."]\n");
	}
    }
}


# Mount partimages' network share.
#
if($SRC =~/smbfs$/)
{
    if($Is_Smbfs_Mounted)
    {
	LOG("* /mnt/smbfs is mounted but we still need to know the Directory\n");

	my $Tries = 1;

	while($Tries)
	{
	    if(defined($P{Directory}) && $P{Directory})
	    {
		LOG("  Directory parameter: [".$P{Directory}."]\n");
	    }
	    else
	    {
		LOG("  No Directory parameter; let's ask for it\n");

		my $cmd = 'dialog --inputbox "Enter a possible subdirectory '
		    .'containing your data '
		    .'(eg. \mydir\PING)" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		$P{Directory} = '';
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{Directory} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
		$P{Directory} =~s/^\s*//;
		$P{Directory} =~s/\s*$//;
		$P{Directory} =~s/\\/\//g;
		$P{Directory} =~s/^\/*//;

		unless($P{Directory})
		{
		    $P{Directory} = "/./";
		}

		LOG("  Got: [".$P{Directory}."]\n");
	    }

	    if(Is_Mounted("/mnt/smbfs"))
	    {
		LOG("* Seems mounted.\n");
		$Tries = 0;

		# Many users forget to unzip Partimage.zip into their share.
		# We'll create the directories for them, and let them know.
		#
		unless(-d "/mnt/smbfs/".$P{Directory}."/Create_New_Image")
		{
		    LOG("/!\\ I see you have no"
			." [/mnt/smbfs/".$P{Directory}."/Create_New_Image]\n");
		    LOG("    directory. I'm only going to create it\n");
		    LOG("    for you, as you definitely want it. See the Howto for\n");
		    LOG("    more info. BTW, the Restore_Only parameter can be used\n");
		    LOG("    to prevent users from making images.\n");
		    sleep($README_SLEEP);
		    my $Done = 1;
		    mkdir("/mnt/smbfs/".$P{Directory}."/Create_New_Image", 0755)
			|| do { --$Done };
		    unless($Done)
		    {
			LOG("\n");
			LOG("!!! Unfortunately, I have no rights to write under"
			    ." the [/mnt/smbfs/".$P{Directory}."] dir.\n");
			LOG("    You should adjust this, refer to the Howto, etc.\n");
			sleep($FAILED_SLEEP);
		    }
		}
		unless(-e "/mnt/smbfs/".$P{Directory}."/Create_New_Image/hda")
		{
		    LOG("     We'll create a blank file"
			." [/mnt/smbfs/".$P{Directory}."/Create_New_Image/hda] for you\n");
		    open(H, ">/mnt/smbfs/".$P{Directory}."/Create_New_Image/hda");
		    close(H);
		}
	    }
	}
    }
    else
    {
	LOG("* /mnt/smbfs is not mounted yet\n");

	my $Tries = 1;

	while($Tries)
	{
	    unless($Tries == 1)
	    {
		foreach("Server", "Share", "User", "Passwd", "Directory")
		{
		    $P{$_} = "";
		}

		my $cmd = 'dialog --colors --msgbox "\Zb\Z7Network Shared Folder'
		    .' Problem!\n\n\n'
		    .'\ZnWe have not succeeded in mounting your network shared folder.'
		    .' Please, provide some other NFS/SMB/CIFS information.\n\n\n" 22 73';
		system($cmd);
	    }

	    unless(defined($P{Server}) && $P{Server})
	    {
		my $cmd = 'dialog --inputbox "Enter a valid ';
		if(YES($P{NFS_Preferred}))    { $cmd .= 'NFS'; }
		elsif(YES($P{FTP_Preferred})) { $cmd .= 'FTP'; }
		else                          { $cmd .= 'SMB'; }
		$cmd .= ' Server IP (eg. 192.168.0.10)" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{Server} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
		$P{Server} =~s/^\/*//;
		$P{Server} =~s/^\\*//;
	    }

	    unless((defined($P{Share}) && $P{Share}) || $P{FTP_Preferred})
	    {
		my $cmd = 'dialog --inputbox "Enter a valid '
		    .($P{NFS_Preferred} ? 'NFS':'SMB')
		    .' Share Name (eg. '
		    .($P{NFS_Preferred} ? '/home/share':'MyShare')
		    .')" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{Share} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
		$P{Share} =~s/^\/*//;
		$P{Share} =~s/^\\*//;
		$P{Share} =~s/\$/\\\$/g;
	    }

	    unless((defined($P{User}) && $P{User}) || $P{NFS_Preferred})
	    {
		my $cmd = 'dialog --inputbox "Enter a valid username '
		    .'(eg. mydomain\johndoe)" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{User} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
		$P{User} =~s/\\+/\//g;
	    }

	    unless((defined($P{Passwd}) && $P{Passwd}) || $P{NFS_Preferred})
	    {
		my $cmd = 'dialog --passwordbox "Enter a valid password '
		    .'(eg. secret)" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{Passwd} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
	    }

	    foreach("Server", "Share", "User", "Passwd", "Directory")
	    {
		$P{$_} = "" unless(defined($P{$_}));
		$P{$_} =~s/^\s*//;
		$P{$_} =~s/\s*$//;
	    }

	    LOG("* Unmounting [/mnt/smbfs]\n");
	    Umount("/mnt/smbfs");

	    LOG("* Trying to mount [//".$P{Server}."/".$P{Share}."] ("
		.($P{NFS_Preferred} ? "nfs":"cifs").")\n");

	    my(@Mount_Possible_Commands) = ();

	    my $cmd = '';
	    if(YES($P{NFS_Preferred}))
	    {
		# Time it out... brutally.
		#
		$cmd = "((sleep 10; kill -9 `ps ax|grep mount|grep nfs|grep -v grep"
		    ." |sed -s \"s| *||\"|cut -d \" \" -f 1`) &);"
		    ." mount -t nfs ".$P{Server}.":"
		    .($P{Share} =~/^\// ? '':'/').$P{Share}." /mnt/smbfs"
		    ." -o nolock >".$TMPDIR."/out 2>&1";
	    }
	    elsif(YES($P{FTP_Preferred}))
	    {
		$cmd = "curlftpfs -o connect_timeout=10"
		  ." ftp://".$P{User}.":".$P{Passwd}."\@".$P{Server}
		    ." /mnt/smbfs >".$TMPDIR."/out 2>&1";
	    }
	    else
	    {
		$cmd = "mount.cifs //".$P{Server}."/".$P{Share}." /mnt/smbfs";
		if($P{User})
		{
		    $cmd .= " -o username=\"".$P{User}."\"";
		}
		$cmd .= ",password=\"".$P{Passwd}."\" >".$TMPDIR."/out 2>&1";
	    }

	    push(@Mount_Possible_Commands, $cmd);

	    # Other possible SMBFS/CIFS mount commands.
	    #
	    if(! $P{NFS_Preferred} && ! $P{FTP_Preferred})
	    {
		$cmd = "mount.cifs //".$P{Server}."/".$P{Share}." /mnt/smbfs";
		if($P{User})
		{
		    my $tmpU = $P{User};
		    if($P{User} =~/\//)
		    {
			$tmpU = (split(/\//, $P{User}))[1];
		    }
		    elsif($P{User} =~/\\/)
		    {
			$tmpU = (split(/\\/, $P{User}))[1];
		    }
		    $cmd .= " -o username=\"".$tmpU."\"";
		}
		$cmd .= ",password=\"$P{Passwd}\" >$TMPDIR/out 2>&1";
		push(@Mount_Possible_Commands, $cmd);

		$cmd = "mount.cifs \\\\\\\\".$P{Server}."\\\\".$P{Share}." /mnt/smbfs";
		if($P{User})
		{
		    $cmd .= " -o username=\"".$P{User}."\"";
		}
		$cmd .= ",password=\"$P{Passwd}\" >$TMPDIR/out 2>&1";
		push(@Mount_Possible_Commands, $cmd);
	    }

	  loop_mount:
	    foreach my $Mount_Cmd (@Mount_Possible_Commands)
	    {
		{
		    my $tmp = $Mount_Cmd;
		    $tmp =~s/password=\"$P{Passwd}\"/password=xxx/g;
		    $tmp =~s/:$P{Passwd}\@/:xxx\@/g;
		    LOG("  Cmd: [".$tmp."]\n");
		}

		system($Mount_Cmd);

		my $out = "";
		if(-e $TMPDIR."/out")
		{
		    open(DB, $TMPDIR."/out");
		    while(<DB>)
		    {
			$out .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/out");
		    LOG("\n");
		    LOG("* SMB/NFS mount output: [".$out."]\n"); 

		    if(YES($P{NFS_Preferred}))
		    {
			my $tmp = `df -P|grep smbfs |wc -l`;
			$tmp =~s/\D//g;
			if($tmp)
			{
			    LOG("\n");
			    LOG("* Successfully mounted (nfs 1)\n");
			    $Tries = 1;
			    sleep($INFO_SLEEP);
			    last loop_mount;
			}
			else
			{
			    LOG("\n");
			    LOG("* No success... Trying again (nfs).\n");
			    $Tries = 2;
			    sleep($FAILED_SLEEP);
			}
		    }
		    elsif(YES($P{FTP_Preferred}))
		    {
			# Do nothing
		    }
		    else
		    {
			my $tmp = `df -P|grep smbfs |wc -l`;
			$tmp =~s/\D//g;
			if($tmp)
			{
			    LOG("\n");
			    LOG("* Successfully mounted (cifs 1)\n");
			    $Tries = 1;
			    sleep($INFO_SLEEP);
			    last loop_mount;
			}
			else
			{
			    LOG("\n");
			    LOG("* No success... Trying again (cifs).\n");
			    $Tries = 2;
			    sleep($FAILED_SLEEP);
			}
		    }
		}
	    }

	    if($Tries == 1)
	    {
		my $cnt = 0;

		my $Mounted = 0;
		opendir(DIR, "/mnt/smbfs/".$P{Directory});
		my(@Files) = readdir(DIR);
		closedir(DIR);
		foreach my $F (@Files)
		{
		    next if($F =~/^\.{1,2}$/);
		    ++ $Mounted;
		    $Tries = 0;
		}
		if($Mounted)
		{
		    LOG("* Found subdirs in [/mnt/smbfs/".$P{Directory}."]."
			." Seems mounted.\n");
		}

		while(! $cnt && ! $Mounted)
		{
		    $P{Directory} = "";
		    my $cmd = 'dialog --inputbox "Enter a possible subdirectory '
			.'containing your data '
			.'(eg. \mydir\PING)" 8 51 2>'.$TMPDIR.'/BLA';
		    system($cmd);
		    $P{Directory} = '';
		    if(-e $TMPDIR."/BLA")
		    {
			open(DB, $TMPDIR."/BLA");
			while(<DB>)
			{
			    $P{Directory} .= $_;
			}
			close(DB);
			unlink($TMPDIR."/BLA");
		    }
		    $P{Directory} =~s/^\s*//;
		    $P{Directory} =~s/\s*$//;
		    $P{Directory} =~s/\\/\//g;
		    $P{Directory} =~s/^\/*//;
		    ++ $cnt;
		}
		$SRC = "/mnt/smbfs/".$P{Directory};
		LOG("* Found SRC: [".$SRC."]\n");
	    }
	}
    }
}


# If addon*.tar.gz/.zip files have been added to the SMB partimage dir,
# they can be untarred to the root of the system now.
#
if($SRC =~/smbfs/)
{
    LOG("* Looking for any addon in the SMB [".$P{Directory}."] dir...\n");
    {
	opendir(DIR, "/mnt/smbfs/".$P{Directory});
	my(@files) = readdir(DIR);
	closedir(DIR);
	foreach(@files)
	{
	    if(m/^addon(\-|_).*\.tar\.(gz|bz2|xz)/i || m/^addon(\-|_).*\.zip/i)
	    {
		LOG("  Addon found! [".$_."]\n");
		Exec_Log("cd /; ".Unzip("/mnt/smbfs/".$P{Directory}."/".$_), 4);
	    }
	}
    }
}


# If a command has been scheduled to be executed after the
# mounting, do so now.
#
LOG("  * Any command to execute after the mounting ?\n");

if(defined($P{Cmd_2}) && $P{Cmd_2})
{
    LOG("    Yes! [".$P{Cmd_2}."]");
    my $out = system($P{Cmd_2});
    LOG("  Output: [".$out."]\n");
}
else
{
    LOG("    No defined command.\n");
}


# If the source is local, we've got to mount the partition where
# images are stored. The user might have several hdds... if so,
# give the possibility to choose which one to use.
#
my @Parts_To_Backup = ();
my $Part_For_Storage = '';

my $New_Second_Part = 0;

if($SRC eq "local")
{
    LOG("* Images are local. Find out what to backup.\n");

    # Only one HDD, only one part, no unpartitionned space
    #
    if($#Dev_Rich == 0 && $#{ $Dev_Rich[0]->{Parts} } == 0)
    {
	LOG("  Only one part. Obviously both src and dest.\n");
	LOG("    And obviously, will want to make an image.\n");

	LOG("  Only one partition. Let's investigate...\n");

	my $Dev_Size = $Dev_Rich[0]->{BIOS_Dev_Size};
	LOG("  - Size of the device: [".$Dev_Size."] bytes\n");

	my $Dev_Type = $Dev_Rich[0]->{Types}->[0];
	LOG("  - Type of the unique part: [".$Dev_Type."]\n");

	my $Used_Space = Used_Space($Dev_Rich[0]->{Parts}->[0], 0);
	LOG("  - Space used by [".$Dev_Rich[0]->{Parts}->[0]."]: [".$Used_Space."] bytes\n");

	my $Avail_Space = $Dev_Size - $Used_Space;
	LOG("  - Available space on [".$Dev_Rich[0]->{Parts}->[0]."]:"
	    ." [".$Avail_Space."] bytes\n");

	my $Useless_Space = 0;

	if($Avail_Space < .5 * $Dev_Size)
	{
	    LOG("  - Let's see if we can delete useless files...\n");

	    Umount("/mnt/dos");
	    Mount("/dev/".$Dev_Rich[0]->{Parts}->[0], "/mnt/dos", "");

	    foreach my $file ("pagefile.sys", "hiberfil.sys", "swapfile.sys")
	    {
		unless(defined($P{Suppress_RootSys_Files}))
		{
		    Ask_If_Suppress_RootSys_Files();
		}
		if(YES($P{Suppress_RootSys_Files}))
		{
		    if(-e "/mnt/dos/".$file)
		    {
			$Useless_Space += (stat("/mnt/dos/".$file))[7];
		    }
		}
	    }
	    if($Useless_Space)
	    {
		$Avail_Space += $Useless_Space;
		$Used_Space -= $Useless_Space;
		LOG("    Yep. Can win [".$Useless_Space."] bytes more.\n");
		LOG("    After removing them, avail. space'd be: [".$Avail_Space."]\n");
		LOG("    and used space should be: [".$Used_Space."]\n");
	    }
	    else
	    {
		LOG("    Nope. No useless space.\n");
	    }

	    Umount("/mnt/dos");
	}

	if($Avail_Space >= .5 * $Dev_Size)
	{
	    LOG("  - Turns out we could resize the unique partition...\n");

	    my $Resize = 0;

	    if(defined($P{Repart}) && $P{Repart} =~/^(y|1)$/i)
	    {
		LOG("    Config file says we can repart!\n");
		$Resize = 1;
	    }
	    else
	    {
		my $cmd = 'dialog --colors --menu "\Zb\ZnYou only have one partition'
		    .' on your hard disk drive ('.$Dev_Rich[0]->{Dev}.'), and PING needs'
		    .' a second partition to write to or restore from saved images.'
		    .'\n\nNevertheless, it seems that there is enough free space for'
		    .' me to dynamically repart your HDD. Do you want me to do so ?'
		    .'\n\nYou definitely SHOULD have a BACKUP of any valuable data'
		    .' before saying Yes here.\n\nEven better, get an USB external'
		    .' drive and store your images in it.\n\n" 19 50 2 '
		    .' "Yes" "" "No" "" 2>'.$TMPDIR.'/checklist.tmp';
		system($cmd);

		if(-z $TMPDIR."/checklist.tmp")
		{
		    Quit();
		}

		open(DB, $TMPDIR."/checklist.tmp");
		while(<DB>)
		{
		    if(m/Y/i)
		    {
			++ $Resize;
			last;
		    }
		}
		close(DB);
		unlink($TMPDIR."/checklist.tmp");
	    }

	    unless($Resize)
	    {
		LOG("  Wisdom has been chosen... exit is the only choice.\n");
		sleep($README_SLEEP);
		Quit();
	    }

	    LOG("  So, we can repart the device [".$Dev_Rich[0]->{Dev}."]\n");

	    if($Useless_Space)
	    {
		LOG("  - Removing useless files on [/dev/"
		    .$Dev_Rich[0]->{Parts}->[0]."]\n");

		Umount("/mnt/dos");
		Mount("/dev/".$Dev_Rich[0]->{Parts}->[0], "/mnt/dos", "");

		foreach my $file ("pagefile.sys", "hiberfil.sys", "swapfile.sys")
		{
		    unless(defined($P{Suppress_RootSys_Files}))
		    {
			Ask_If_Suppress_RootSys_Files();
		    }
		    if(YES($P{Suppress_RootSys_Files}))
		    {
			if(-e "/mnt/dos/".$file)
			{
			    Exec_Log("cd /mnt/dos; chmod 666 ".$file.";"
				     ." rm -f ".$file."; sync", 4);
			    LOG("    Deleting [/mnt/dos/".$file."]\n");
			}
		    }
		    else
		    {
			LOG("    Won't delete [/mnt/dos/".$file."]. Unwanted.\n");
		    }
		}

		Umount("/mnt/dos");
	    }

	    LOG("  - Estimating [/dev/".$Dev_Rich[0]->{Parts}->[0]."] future size\n");

	    my $New_Size = Part_Minimum_Size("/dev/".$Dev_Rich[0]->{Parts}->[0]);

	    unless($New_Size)
	    {
		LOG("    !!! We won't be able to resize. Aborting now.\n");
		sleep($FAILED_SLEEP);
		Quit();
	    }

	    # Not too much, yet.
	    #
	    if($New_Size < .5 * $Dev_Size)
	    {
		$New_Size = int($Dev_Size / 2) + 1;
		LOG("    Reducing to [".$New_Size."] bytes will be enough.\n");
	    }

	    # mkfs.vfat won't operate if the volume is too small
	    # (who knows what data there is on the C: drive after all)
	    #
	    if(($Dev_Size - $New_Size) < 40000000)
	    {
		$New_Size = $Dev_Size - 40000000;
		LOG("    New part would be too small; reducing to [".$New_Size."] bytes\n");
	    }

	    if($Used_Space > $New_Size || $New_Size == 0)
	    {
		LOG("    !!! Space problem. Aborting now.\n");
		sleep($FAILED_SLEEP);
		Quit();
	    }

	    LOG("  - Resizing to [".$New_Size."] bytes!!\n");

	    # Not anymore cylinders. Now, fdisk takes sectors (or K,M,G,T,P). >2015
	    #
	    # my $New_Size_Cyl =
	    #   int($New_Size / ($Dev_Rich[0]->{Heads}
	    #     * $Dev_Rich[0]->{Sectors_Track}
	    #     * $Dev_Rich[0]->{BIOS_Sector_Size}));
	    # LOG("  - well, to [".$New_Size_Cyl."] cylinders\n");

	    my $New_Size_Sectors = int($New_Size / $Dev_Rich[0]->{BIOS_Sector_Size}) + 1;
	    LOG("  - well, to [".$New_Size_Sectors."] Sectors\n");

	    if(FS_Resize($Dev_Rich[0]->{Parts}->[0], $New_Size_Sectors, $New_Size))
	    {
		LOG("    !!! We could not resize that filesystem.\n");
		sleep($FAILED_SLEEP);
		Quit();
	    }
	    else
	    {
		LOG("    The resizing seems OK. Good.\n");
	    }

	    # Delete all parts...
	    #
	    Delete_All_Parts($Dev_Rich[0]->{Dev}, \@Dev_Rich);

	    # Adjust the partition table
	    #
	    $Dev_Rich[0]->{End}->[0] = $Dev_Rich[0]->{Start}->[0]
		+ $New_Size_Sectors;

	    # Now, we'll write images on the second part.
	    #
	    push(@{ $Dev_Rich[0]->{Parts} }, $Dev_Rich[0]->{Dev}."2");
	    push(@{ $Dev_Rich[0]->{Types} }, "c");
	    push(@{ $Dev_Rich[0]->{FS_Types} }, "fat32");
	    push(@{ $Dev_Rich[0]->{Dirs} }, "");
	    push(@{ $Dev_Rich[0]->{Labels} }, "");
	    push(@{ $Dev_Rich[0]->{Boot_Flags} }, 0);
	    push(@{ $Dev_Rich[0]->{Start} }, $Dev_Rich[0]->{Start}->[0]
		 + $New_Size_Sectors + 1);
	    push(@{ $Dev_Rich[0]->{End} },
		 $Dev_Rich[0]->{Cylinders} * $Dev_Rich[0]->{Heads} * $Dev_Rich[0]->{Sectors_Track});
	    push(@{ $Dev_Rich[0]->{Sectors} }, $Dev_Rich[0]->{Sectors}
		 - $Dev_Rich[0]->{Start}->[0] - 1);
	    push(@{ $Dev_Rich[0]->{Size} },
		 ($Dev_Rich[0]->{Sectors} - $Dev_Rich[0]->{Start}->[0] - 1)
		 * $Dev_Rich[0]->{BIOS_Sector_Size});
	    push(@{ $Dev_Rich[0]->{Used_Space} }, 0);

	    ++ $New_Second_Part;   # So we won't ask silly questions...

	    # Recreate partitions
	    #
	    Recreate_All_Parts($Dev_Rich[0]->{Dev}, \@Dev_Rich);

	    LOG("  - Formating the new partition [/dev/"
		.$Dev_Rich[0]->{Parts}->[1]."] (FAT32)\n");

	    Exec_Log("mkfs.vfat -F 32 /dev/".$Dev_Rich[0]->{Parts}->[1]);

	    LOG("  - Rediscover HDD's structure\n");
	    HDD_Discover(\@Dev, \@Dev_Rich, \@RAID_Members);

	    @Parts_To_Backup = $Dev_Rich[0]->{Parts}->[0];
	    $Part_For_Storage = $Dev_Rich[0]->{Parts}->[1];

	    LOG("  - Evident deductions (are we clever):\n");
	    LOG("    Part to Backup: [".$Parts_To_Backup[0]."]\n");
	    LOG("    Part for Storage: [".$Part_For_Storage."]\n");
	}
	else
	{
	    LOG("  - Aie. The only present part occupies more than half disk space.\n");
	    LOG("    There's nothing we can do. Better exit now.\n");
	    sleep($README_SLEEP);
	    Quit();
	}
    }

    # Only one partition on one device, but unpartitionned space.
    # This case won't be handled here.
}

LOG("  Asking what parts to backup or restore\n");

if(defined($P{Image_To_Restore}) && $P{Image_To_Restore}
   && $P{Image_To_Restore} !=/^Create_New_Image$/i)
{
    LOG("    The user has passed a param for Image_To_Restore.\n");
    LOG("    => Be clever, assume he wants a restoration !\n");

    $GLOBAL_ACTION = "Restoration";
}
else
{
    if(defined($P{Image_To_Restore}) && $P{Image_To_Restore} =~/^Create_New_Image$/i)
    {
	LOG("    The user wants an automatic image creation.\n");
    }
    else
    {
	LOG("    No param passed for Image_To_Restore.\n");
    }

    if(YES($P{Restore_Only}))
    {
	LOG("    The user has set param Restore_Only to Y.\n");
    }
    else
    {
	LOG("    Param Restore_Only has not be set to Y; asking...\n");

	LOG("    Has the user set parameter Parts_To_Backup ?\n");
	if(defined($P{Parts_To_Backup}))
	{
	    LOG("      Yes! We've got: [".$P{Parts_To_Backup}."]\n");
	    @Parts_To_Backup = split(/\,/, $P{Parts_To_Backup});
	}
	else
	{
	    LOG("      No! Ask.\n");

	    while(1)
	    {
		my $EXIT = 0;

		my $cmd = 'dialog --colors --checklist "\Zb\Z7Choose the partitions'
		    .' to backup.\n\n'
		    .'\ZnNote that you cannot store a partition on itself. So,'
		    .' every partition but one (the destination) can be checked.\n\n'
		    .'****************************************************************\n'
		    .'*** Use SPACE to SELECT the entry(ies), only after hit ENTER ***\n'
		    .'****************************************************************\n\n"'
		    .' 20 73 7 ';

		if(! defined($P{Image_To_Restore})
		   || (defined($P{Image_To_Restore})
		       && $P{Image_To_Restore} !~/^Create_New_Image$/i))
		{
		    $cmd .= ' "    ### CHOOSE THIS if you want a'
			.' RESTORATION ###" "" off';
		}

		my $Nb_Parts = 0;
		foreach my $D (@Dev_Rich)
		{
		    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
		    {
			if($D->{Parts}->[$i] eq 'null')
			{
			    next;
			}

			my $Info = "";
			if($D->{Labels}->[$i])
			{
			    $Info = " (Label: ".$D->{Labels}->[$i].")";
			}
			else
			{
			    $Info = " (".substr($D->{Dirs}->[$i], 0, 35);
			    $Info .= "..." if(length($D->{Dirs}->[$i]) > 35);
			    $Info .= ")";
			    $Info =~s/ \(\)//;
			}

			$cmd .= ' "'.$D->{Parts}->[$i]
			    .' ('.ID_To_Type($D->{Types}->[$i]).')'.$Info.'" "" off';

			++ $Nb_Parts;
		    }
		}

		$cmd .= ' 2>'.$TMPDIR.'/checklist.tmp';

		system($cmd);

		# What we get:
		# "hda1\ \(Linux\)\ \(lost+found,grub\)" "hda2\ \(Linux\ LVM\)" "mapper/VolGroup00-LogVol00\ \(\)\ \(mnt,root,tmp,usr,opt,bin,selinux,sr...\)" "mapper/VolGroup00-LogVol01\ \(Linux\)"

		my $tmp = '';
		open(DB, $TMPDIR."/checklist.tmp");
		while(<DB>)
		{
		    s/^\s*//;
		    s/\s*$//;
		    $tmp .= $_;
		}
		close(DB);
		unlink($TMPDIR."/checklist.tmp");

		if(! $tmp)
		{
		    LOG("\n");
		    LOG("Please, use the SPACE BAR to make a choice.\n");
		    sleep($README_SLEEP);
		}
		else
		{
		    @Parts_To_Backup = ();

		    my(@fields) = split(/\" \"/, $tmp);
		    foreach(@fields)
		    {
			s/\"//g;
			s/^\s*//;
			s/\s*$//;
			s/[^\/\-_0-9a-zA-Z].*$//;
			push(@Parts_To_Backup, $_);
			LOG("    To backup: [".$_."]\n");
		    }

		    if(! $Parts_To_Backup[0])
		    {
			$GLOBAL_ACTION = "Restoration";

			LOG("    A restoration has been asked.\n");
			++ $EXIT;
		    }
		    else
		    {
			$GLOBAL_ACTION = "Image Creation";

			LOG("    Nb parts to backup: [".($#Parts_To_Backup + 1)."]\n");
			LOG("    Nb not null seen parts: [".$Nb_Parts."]\n");
		
			if($SRC eq "local")
			{
			    LOG("    Local backup. Have to check if there's"
				." at least one spare part\n");

			    if($#Parts_To_Backup + 1 < $Nb_Parts)
			    {
				LOG("    Cool, the user did not check every part."
				    ." Go on!\n");
				++ $EXIT;
			    }
			    else
			    {
				LOG("    You must leave at least one part unchecked\n");
				LOG("    ...to store the backup somewhere :)\n");
				sleep(4);
			    }
			}
			else
			{
			    LOG("    Not a local backup. Can choose to backup"
				." all parts\n");
			    ++ $EXIT;
			}
		    }

		    last if($EXIT);
		}
	    }
	}
    }
}

LOG("  Global Action: [".$GLOBAL_ACTION."]\n");

if($SRC eq "local")
{
    LOG("  Asking where to store / where is stored, and mounting that part\n");
    {
	my $Mounted = 0;

	# Here, handle the case the user has provided a Server entry about
	# a local partition storing the image to restore automatically.
	# In this case, we can have:
	#   Server=/dev/hda1
	# or
	#   Server=/dev/hda1,/dev/sda1,/dev/hda2 ...
	#
	# We must mount the entry(ies) provided and see if in a possible
	# Directory folder, we can find the Image_To_Restore .
	#
	LOG("    Has the user provided a /dev/...-like Server entry\n");
	LOG("      and an Image_To_Restore entry ?\n");

	if($P{Server} =~/^\/dev/
	   && defined($P{Image_To_Restore}) && $P{Image_To_Restore})
	{
	    LOG("      Yes! Let's try to mount it and find what to restore.\n");
	    my(@ldev) = split(/\,/, $P{Server});
	    foreach my $ldev (@ldev)
	    {
		LOG("      Trying [".$ldev."]...\n");
		Umount("/mnt/dos");
		Mount($ldev, "/mnt/dos", "");

		if(Is_Mounted($ldev))
		{
		    LOG("      [".$ldev."] is mounted !\n");
		    my $tmp = "/mnt/dos".($P{Directory} ? $P{Directory}:"/");
		    $tmp .= ($tmp =~/\/$/ ? "":"/");
		    unless($P{Image_To_Restore} =~/^Create_New_Image$/i)
		    {
			# As it makes no sense to force users to have an empty
			# /Create_New_Image on their target device since they
			# have defined that target...

			$tmp .= $P{Image_To_Restore};
		    }
		    LOG("      Any [".$tmp."] found ?\n");
		    if(-d $tmp)
		    {
			LOG("        Yes! Good!\n");
			$Part_For_Storage = $P{Server};
			$Part_For_Storage =~s/^\/dev\///;
			LOG("        Part for Storage: [".$Part_For_Storage."]\n");
			$Mounted = 1;
		    }
		    else
		    {
			LOG("        No... Next device to try, if any\n");
		    }
		}
		else
		{
		    LOG("      [".$ldev."] couldn't be mounted. Next, if any.\n");
		}
	    }
	}
	else
	{
	    LOG("      Nope. Go on the interactive way.\n");
	}

	while(! $Mounted)
	{
	    my $cmd = 'dialog --colors --menu "\ZnChoose the partition where ';

	    if(! $Parts_To_Backup[0] || YES($P{Restore_Only}))
	    {
		$cmd .= 'the images are stored';
	    }
	    else
	    {
		$cmd .= 'to store the image';
	    }
	    $cmd .= '.\n\n" 20 73 7 ';

	    foreach my $D (@Dev_Rich)
	    {
		for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
		{
		    if($D->{Parts}->[$i] eq 'null')
		    {
			next;
		    }
		    my $flag = 0;
		    foreach my $Have (@Parts_To_Backup)
		    {
			if($Have eq $D->{Parts}->[$i])
			{
			    ++ $flag;
			}
		    }
		    unless($flag)
		    {
			my $Info = "";
			if($D->{Labels}->[$i])
			{
			    $Info = " (Label: ".$D->{Labels}->[$i].")";
			}
			else
			{
			    $Info = " (".substr($D->{Dirs}->[$i], 0, 35);
			    $Info .= "..." if(length($D->{Dirs}->[$i]) > 35);
			    $Info .= ")";
			    $Info =~s/ \(\)//;
			}

			$cmd .= ' "'.$D->{Parts}->[$i].' ('
			    .ID_To_Type($D->{Types}->[$i]).')'.$Info.'" ""';
		    }
		}
	    }

	    $cmd .= ' 2>'.$TMPDIR.'/checklist.tmp';
	    LOG("      Cmd: [".$cmd."]\n");

	    system($cmd);

	    my $tmp = "";
	    open(DB, $TMPDIR."/checklist.tmp");
	    while(<DB>)
	    {
		$tmp .= $_;
	    }
	    close(DB);
	    unlink($TMPDIR."/checklist.tmp");

	    $Part_For_Storage = $tmp;
	    $Part_For_Storage =~s/^\s*//;
	    $Part_For_Storage =~s/\s*$//;
	    $Part_For_Storage =~s/[^0-9a-zA-Z].*$//;
	    LOG("    Part for Storage: [".$Part_For_Storage."]\n");

	    LOG("    Mounting [/dev/".$Part_For_Storage."]...\n");

	    Umount("/mnt/dos");
	    Mount("/dev/".$Part_For_Storage, "/mnt/dos", "");

	    $tmp = `df -P|grep dos |wc -l`;
	    $tmp =~s/\D//g;
	    if($tmp)
	    {
		LOG("  Mounted !\n");
		++ $Mounted;
	    }
	    else
	    {
		LOG("    ! Could not mount the device at all. TRY AGAIN.\n");
		sleep($README_SLEEP);
	    }
	}
    }
}

if($SRC eq "local")
{
    $SRC = "/mnt/dos";
}

my $Found = 0;

if($SRC =~/cdrom/)
{
    $P{Directory} = '';
}
else
{
    if($New_Second_Part)
    {
	LOG("  The dest part is new. Creating a /PING directory on it.\n");

	Umount($SRC);
	Mount("/dev/".$Part_For_Storage, $SRC, "");
	Exec_Log("mkdir ".$SRC."/PING", 4);

	$P{Directory} = "/PING";
    }
    else
    {
	if($P{Directory} && -d $SRC."/".$P{Directory})
	{
	    # from the preconfig
	    LOG("  Found !\n");
	    ++ $Found;
	}
	else
	{
	    while(! $Found)
	    {
		$P{Directory} = "";
		my $cmd = 'dialog --inputbox "Enter a root directory '
		    .'containing your data '
		    .'(eg. \mydir\PING)" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		$P{Directory} = '';
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$P{Directory} .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
		$P{Directory} =~s/^\s*//;
		$P{Directory} =~s/\s*$//;
		$P{Directory} =~s/\\/\//g;
		$P{Directory} =~s/^\/*//;

		LOG("  Chosen root subdir: [".$P{Directory}."]\n");

		if(-d $SRC."/".$P{Directory})
		{
		    LOG("  Found !\n");
		    ++ $Found;
		}
		else
		{
		    LOG("  ! The [".$SRC."/".$P{Directory}."] could not be found."
			." Try again.\n");
		}
	    }
	}
    }
}

$SRC = $SRC."/".$P{Directory};
LOG("* Found SRC: [".$SRC."]\n");


# Get the list of all partimaged Entries.
# Listing the share's directories gives it. And so there's no need
# to modify this script every time a new entry is added...
#
# Note: a directory name starting with ___ won't be listed, so to
#   give admins an easy way to hide some images not to be deployed.
#
my @Entities = ();

if($SRC =~/smbfs/ || $SRC =~/dos/)
{
    opendir(DIR, $SRC);
    my @F = readdir(DIR);
    closedir(DIR);

    foreach(@F)
    {
        next if m/^\.{1,2}$/;
        next unless(-d $SRC."/".$_);
	if(m/^___/)
	{
	    next;
	}
        push(@Entities, $_);
    }

    if($#Entities < 0 && $SRC =~/smbfs/)
    {
        LOG("!!! No directory could be found in [".$SRC."].\n");
	LOG("    No image directory, and no Partimage.zip-made directory. Nothin'\n");
	LOG("    Maybe you've provided the wrong directory, or forgotten to\n");
	LOG("    prepare it properly. We'll abort now, sorry.\n");
	sleep($FAILED_SLEEP);
        Quit();
    }
}


# If the user has chosen a local copy, he obviously wants to be
# able to create a new image etc. So, let's add the special directories
# if he has forgotten to create them.
#
if($SRC =~/dos/)
{
    foreach my $S ("Create_New_Image", "Blank_Local_Admin_Passwd")
    {
	# Don't propose to create an image if the user has checked that
	# he doesn't want to backup anything.
	#
	next if($S eq "Create_New_Image" && defined($Parts_To_Backup[0])
		&& $Parts_To_Backup[0] =~/Choose/i);
	next if($S eq "Create_New_Image" && YES($P{Restore_Only}));

	my $flag = 0;
	foreach(@Entities)
	{
	    if(m/^$S$/i)
	    {
		++ $flag;
		last;
	    }
	}
	unless($flag)
	{
	    push(@Entities, $S);
	}
    }
}


# Display special images first, or not at all if this is a restoration.
# Don't display any restorable image if this is an image creation, so
# to avoid disasters (people not choosing Create_New_Image and overwriting
# their own OS).
#
{
    my(@New) = ();
    foreach(@Entities)
    {
	if(m/^Create_New_Image$/i || m/^Blank_Local_Admin_Passwd$/i)
	{
	    unless($GLOBAL_ACTION eq "Restoration" && m/^Create_New_Image$/i)
	    {
		push(@New, $_);
	    }
	}
    }
    if($GLOBAL_ACTION eq "Restoration" || $P{Image_To_Restore})
    {
	foreach(@Entities)
	{
	    unless(m/^Create_New_Image$/i || m/^Blank_Local_Admin_Passwd$/i)
	    {
		push(@New, $_);
	    }
	}
    }
    @Entities = @New;

    LOG("  Found...:\n");
    foreach(@Entities)
    {
	LOG("    - [".$_."]\n");
    }
}


# Which entry will we install ?
#
LOG("* Which entry will we install ?\n");

my $Entity = '/';

{
    my $browse = 1;

    if(defined($P{Image_To_Restore}) && $P{Image_To_Restore})
    {
	LOG("  The user has passed a param for this: [".$P{Image_To_Restore}."]\n");
        foreach(@Entities)
	{
	    if(m/^$P{Image_To_Restore}$/i)
	    {
		LOG("  Found among the directories: [".$_."]\n");
		$Entity = $_;
		$browse = 0;
		last;
	    }
	}
	if($browse)
	{
	    LOG("  ! This image cannot be found among the directories\n");
	    LOG("    We had only:\n");
	    foreach(@Entities)
	    {
		LOG("    - [".$_."]\n");
	    }
	    sleep($TIP_SLEEP);
	    LOG("    We'll have to browse and ask you what to restore\n");
	    sleep($TIP_SLEEP);
	    $P{Image_To_Restore} = '';
	}
    }

    if($browse && ($SRC =~/smbfs/ || $SRC =~/dos/))
    {
	my $cmd = 'dialog --colors --menu "\Zb\Z7Actions and Available images for'
	    .' restoration...\n\n'
	    .(YES($P{Restore_Only}) ? '':'\ZnChoose Create_New_Image if'
	      .' you want a Ghost-like image of your partition(s)')
	    .'" 20 60 8 ';
	foreach(@Entities)
	{
	    # Don't propose to create an image if the user has checked that
	    # he doesn't want to backup anything.
	    #
	    if(($_ eq "Create_New_Image" || $_ eq "Blank_Local_Admin_Passwd")
	       && YES($P{Restore_Only}))
	    {
		next;
	    }
	    $cmd .= '"'.$_.'" "" ';
	}
	if($#Entities < 0)
	{
	    # Our menu wouldn't be ok anyway.
	    #
	    LOG("    !!! You've asked for a restoration, but there's no\n");
	    LOG("        image in the directory you've provided.\n");
	    LOG("        Quitting...\n");
	    sleep($FAILED_SLEEP);
	    Quit();
	}
	$cmd .= ' 2>'.$TMPDIR.'/BLA';
	LOG("    Cmd: [".$cmd."]\n");
	system($cmd);
	if(-e $TMPDIR."/BLA")
	{
	    open(DB, $TMPDIR."/BLA");
	    while(<DB>)
	    {
		$Entity .= $_;
	    }
	    close(DB);
	    unlink($TMPDIR."/BLA");
	}
	$Entity =~s/^\s+//g;
	$Entity =~s/\s+$//g;
	$Entity =~s/^\///g;
    }
}

LOG("  To install: [".$Entity."]\n");


# Restore partitions.
# Naming convention: files sda1.000 sda1.001 etc. => /dev/sda1.
#                    files askme_a1.000 askme_a1.001 etc. => Ask me!
# File 'sda' contains partitionning information and must be dumped first.
# (or file 'askme_a').
#
my $Have_Restored = 0;
my $Have_Minimized_Before_Storing = 0;
my(@Minimized_Devices) = ();

if($Entity =~/Blank_Local_Admin_Passwd/i
   || $Entity =~/Create_New_Image/i)
{
    LOG("* Either image creation, either local admin passwd to blank\n");

    if($Entity =~/Create_New_Image/i)
    {
	LOG("* Image creation\n");

	# Do something for the case there's a Dell Utility Partition
	#
	LOG("  Save user's time if there's a Dell Utility part\n");

	foreach my $D (@Dev_Rich)
	{
	    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	    {
		if(defined($D->{Types}->[$i])
		   && Is_Dell_Type($D->{Types}->[$i]) && $HELP_DELL eq "")
		{
		    LOG("\n");
		    my(@W) = ();
		    $W[0] = "It appears that you're about to clone a Dell box,"
			." as there's a so-called Dell Utility partition."
			." Please, be aware that several users have reported"
			." problems with the cloning of systems containing this"
			." Dell Utility partition. You might choose...\n";
		    $W[1] = "1. Go on anyway! (not recommended)\n";
		    $W[2] = "2. Prepare this system yourself, this way\n"
			."   => - Stop this image creation\n"
			."      - Remove the Dell Utility partition\n"
			."      - Extend the other partition so to use all space\n"
			."      - Fix your boot.ini file so it will boot the 1st part\n"
			."      - Launch PING again to create your image.\n";
		    $W[3] = "3. Let us store only the second partition (C:\\).\n";
		    $W[4] = "We recommend you to choose the 3rd option, because"
			." we have scripted the whole thing so to have your future"
			." restorations use all available space on the drive, with"
			." a boot.ini file modified for you on the fly, and a fixed"
			." MBR and Boot Sector.";

		    LOG("  Issuing this warning:\n");
		    foreach(@W)
		    {
			LOG("    [".$_."]\n");
		    }

		    open(W, ">".$TMPDIR."/warning");
		    print W wrap('', '', join("\n", @W));
		    close(W);

		    system("reset; clear; more ".$TMPDIR."/warning");
		    unlink($TMPDIR."/warning");

		    my $Grab = '';
		    my $cnt = 0;
		    while($Grab !~/^(1|2|3)/)
		    {
			if($cnt)
			{
			    print "\nPlease, type 1, 2 or 3.\n\n>> ";
			}
			print "\n>> ";
			$Grab = <STDIN>;
			if($Grab =~/^2/)
			{
			    LOG("      Has chosen to quit.\n");
			    Quit();
			}
			elsif($Grab =~/^3/)
			{
			    LOG("      Has chosen option 3. Hurrah!\n");
			    ++ $HELP_DELL;
			}
			++ $cnt;
		    }
		}
	    }
	}

	# Name the future image
	#	
	my $New_Image = '';

	LOG("* Getting the name of the future image\n");
	LOG("  Has the user set it on a parameter ?\n");

	if(defined($P{New_Image_Name}) && $P{New_Image_Name})
	{
	    LOG("    Yes! will be [".$P{New_Image_Name}."]\n");
	    $New_Image = $P{New_Image_Name};
	}
	else
	{
	    LOG("    No; let's ask\n");

	    while(length($New_Image) < 1)
	    {
		my $cmd = 'dialog --inputbox "Enter the name of the '
		    .'new image :" 8 51 2>'.$TMPDIR.'/BLA';
		system($cmd);
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			$New_Image .= $_;
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
	    }
	}
	$New_Image =~s/^\s*//;
	$New_Image =~s/\s*$//;
	$New_Image =~s/\s/_/g;
	$New_Image =~s/\(/_/g;
	$New_Image =~s/\)/_/g;
	$New_Image =~s/\[/_/g;
	$New_Image =~s/\]/_/g;

	LOG("  Name of future image: [".$New_Image."]\n");

	# Give the user the possibility to store recorded files details,
	# in order to make future incremential backup possible.
	#
	LOG("  Ask if we should store file details\n");

	if(defined($P{Store_MD5}))
	{
	    LOG("  There's a preconfig entry; worth [".$P{Store_MD5}."]\n");
	}
	else
	{
	    LOG("  There's no preconfig predefined info\n");

	    my $cmd = 'dialog --colors --menu "\Zb\ZnWe can store details about'
		.' each recorded file, in order to make future incremential'
		.' image creation possible. It will take some more time first,'
		.' but will allow small updates rather than new images to be'
		.' written from scratch. Note also that unfortunately,'
		.' NTFS ACL permissions are NOT handled. So, do you want us'
		.' to record the info ?\n\nNote: ACLs *not* handled.\n\n" 17 65 2 '
		.' "No" "" "Yes" "" 2>'.$TMPDIR.'/checklist.tmp';
	    system($cmd);

	    if(-z $TMPDIR."/checklist.tmp")
	    {
		Quit();
	    }

	    open(DB, $TMPDIR."/checklist.tmp");
	    while(<DB>)
	    {
		if(m/Y/i)
		{
		    $P{Store_MD5} = 1;
		    last;
		}
	    }
	    close(DB);
	    unlink($TMPDIR."/checklist.tmp");

	    LOG("    ".($P{Store_MD5} ? "Yes!":"No")."\n");
	}

	# Give the user the possibility to choose between gzip and bzip2
	#
	LOG("* What compressor will be used ?\n");
	my $Compression_Type = 'gzip';
	if(defined($P{Compression_Type}) && $P{Compression_Type})
	{
	    LOG("  The user has provided an entry =>[".$P{Compression_Type}."]\n");
	    if($P{Compression_Type} =~/gzip/i)
	    {
		$Compression_Type = 'gzip';
	    }
	    elsif($P{Compression_Type} =~/bzip2/i)
	    {
		$Compression_Type = 'bzip2';
	    }
	    elsif($P{Compression_Type} =~/no\s*compression/i)
	    {
		$Compression_Type = 'no compression';
	    }
	    LOG("  Compression type to be used: [".$Compression_Type."]\n");
	}
	else
	{
	    LOG("  No param entry; let's ask the user\n");
	    my $cmd = 'dialog --colors --menu "\Zb\ZnDo you prefer gzip (faster),'
		.' bzip2 (less used space), or no compression ?\n\n" 12 50 3 '
		.' "gzip" "" "bzip2" "" "no compression" "" 2>'.$TMPDIR.'/checklist.tmp';
	    system($cmd);

	    if(-z $TMPDIR."/checklist.tmp")
	    {
		Quit();
	    }

	    open(DB, $TMPDIR."/checklist.tmp");
	    while(<DB>)
	    {
		if(m/bzip2/i)
		{
		    $Compression_Type = 'bzip2';
		    last;
		}
		elsif(m/no/i)
		{
		    $Compression_Type = 'no compression';
		    last;
		}
	    }
	    close(DB);
	    unlink($TMPDIR."/checklist.tmp");
	}
	LOG("* Chosen compression type: [".$Compression_Type."]\n");

	# Give the user the possibility to choose partclone, zsplit or a tarball
	# over partimage
	#
	LOG("  Ask if partclone, zsplit, fsarchiver or a tarball must"
	    ." be preferred to partimage\n");

	if(defined($P{Zsplit_Preferred}))
	{
	    LOG("    There's a preconfig entry; worth [".$P{Zsplit_Preferred}."]\n");
	}
	if(defined($P{Tarball_Preferred}))
	{
	    LOG("    There's a preconfig entry; worth [".$P{Tarball_Preferred}."]\n");
	}
	if(defined($P{Partclone_Preferred}))
	{
	    LOG("    There's a preconfig entry; worth [".$P{Partclone_Preferred}."]\n");
	}
	if(defined($P{FSArchiver_Preferred}))
	{
	    LOG("    There's a preconfig entry; worth [".$P{FSArchiver_Preferred}."]\n");
	}
	if(! defined($P{Zsplit_Preferred}) && ! defined($P{Tarball_Preferred})
	   && ! defined($P{Partclone_Preferred}) && ! defined($P{FSArchiver_Preferred}))
	{
	    LOG("    The user did not provide a Zsplit_Preferred entry\n");
	    LOG("      nor a Tarball_Preferred, nor a Partclone_Preferred entry,\n");
	    LOG("      nor a FSArchiver_Preferred entry in a ping.conf file => Ask.\n");

	    my $cmd = 'dialog --colors --menu "\Zb\Z7'.$PRODUCT_NAME.'\n\n'
		.'\ZnDo you want partclone, zsplit, fsarchiver or tar+gzip to be used instead'
                .' of partimage ? If unsure, choose Partimage; if it fails,'
		.' we'."'".'ll try any other tool in below order.\n\n" 18 55 5 '
		.' "Partimage (Best choice)" "" "Partclone (2nd best choice)" ""'
		.' "Zsplit (Will dump: safest, longest)" "" "FSArchiver (Very new, YMMV)" ""'
		.' "Tarball (Will zip files; last chance choice!)" ""'
		.' 2>'.$TMPDIR.'/checklist.tmp';
	    system($cmd);

	    if(-z $TMPDIR."/checklist.tmp")
	    {
		Quit();
	    }

	    open(DB, $TMPDIR."/checklist.tmp");
	    while(<DB>)
	    {
		if(m/zsplit/i)
		{
		    $P{Zsplit_Preferred} = 1;
		    $P{Tarball_Preferred} = 0;
		    $P{Partclone_Preferred} = 0;
		    $P{FSArchiver_Preferred} = 0;
		    LOG("    Zsplit!\n");
		}
		elsif(m/tarball/i)
		{
		    $P{Zsplit_Preferred} = 0;
		    $P{Tarball_Preferred} = 1;
		    $P{Partclone_Preferred} = 0;
		    $P{FSArchiver_Preferred} = 0;
		    LOG("    Tarball!\n");
		}
		elsif(m/partclone/i)
		{
		    $P{Zsplit_Preferred} = 0;
		    $P{Tarball_Preferred} = 0;
		    $P{Partclone_Preferred} = 1;
		    $P{FSArchiver_Preferred} = 0;
		    LOG("    Partclone!\n");
		}
		elsif(m/fsarchiver/i)
		{
		    $P{Zsplit_Preferred} = 0;
		    $P{Tarball_Preferred} = 0;
		    $P{Partclone_Preferred} = 0;
		    $P{FSArchiver_Preferred} = 1;
		    LOG("    FSArchiver!\n");
		}
		else
		{
		    $P{Zsplit_Preferred} = 0;
		    $P{Tarball_Preferred} = 0;
		    $P{Partclone_Preferred} = 0;
		    $P{FSArchiver_Preferred} = 0;
		    LOG("    Partimage!\n");
		}
	    }
	    close(DB);
	    unlink($TMPDIR."/checklist.tmp");
	}

	# It can be interesting to reduce the size of the partition
	# before storing it. Thus, it's possible to restore it later
	# into a smaller partition. Note that even if we decide later
	# to restore into a equally-big or bigger partition, PING will
	# always try to maximize the size of the filesystem at the end.
	#
	LOG("  Ask if we should minimize NTFS filesystems before storing them\n");

	if(defined($P{Minimize_Before_Storing}))
	{
	    LOG("  There's a preconfig entry; worth [".$P{Minimize_Before_Storing}."]\n");
	}
	else
	{
	    LOG("  There's no preconfig predefined info\n");

	    if(defined($P{AUTO}) && $P{AUTO})
	    {
		LOG("  AUTO param set! don't ask, minimize\n");
		$P{Minimize_Before_Storing} = 1;
	    }
	    elsif(YES($P{Tarball_Preferred}) || YES($P{FSArchiver_Preferred}))
	    {
		LOG("  We've been asked for a tarball or FSArchiver. No need to minimize. Don't propose.\n");
		$P{Minimize_Before_Storing} = 0;
	    }
	    else
	    {
		LOG("  AUTO param not set... let's ask the user\n");

		my $cmd = 'dialog --colors --menu "\Zb\ZnMost filesystems can be'
		    .' reduced before being stored. It permits restoring them to'
		    .' smaller partitions. Do you want us to minimize ?\n\nChoose'
		    .' NO unless *EVERYTHING* is BACKUPED !!!\n\n" 15 50 2 '
		    .' "No" "" "Yes" "" 2>'.$TMPDIR.'/checklist.tmp';
		system($cmd);

		if(-z $TMPDIR."/checklist.tmp")
		{
		    Quit();
		}

		open(DB, $TMPDIR."/checklist.tmp");
		while(<DB>)
		{
		    if(m/Y/i)
		    {
			$P{Minimize_Before_Storing} = 1;
			last;
		    }
		}
		close(DB);
		unlink("$TMPDIR/checklist.tmp");

		LOG("    ".($P{Minimize_Before_Storing} ? "Yes!":"No")."\n");
	    }
	}


	# If the user has asked for a local image to be done, then we
	# might have to mount the dest part with NTFS-3G, for it
	# to be writable. By default, we did not, as reading is faster
	# with native kernel NTFS read-only drivers.
	#
	if($SRC =~/dos/i)
	{
	    LOG("* A local image was asked. Checking [/dev/".$Part_For_Storage."] FS...\n");

	    my $FS = Part_Type($Part_For_Storage);
	    LOG("  Filesystem ID found: [".$FS."]\n");

	    if(Is_NTFS($FS))
	    {
		LOG("  This means NTFS. Remounting it R/W.\n");
		Umount("/mnt/dos");
		Mount("/dev/".$Part_For_Storage, "/mnt/dos", "RW");

		LOG("  Checking the mounting...\n");
		if(Is_Mounted("/dev/".$Part_For_Storage))
		{
		    LOG("  Mounted !\n");
		}
		else
		{
		    LOG("  ! Could not mount the device at all. Exit.\n");
		    sleep($README_SLEEP);
		    Quit();
		}
	    }
	}

	# If there's already a directory called after the name of the image
	# the user wants to create, there can be three interesting choices :
	# - Either replace it
	# - Either rename the old dir to xxx.OLD.$$
	# - Either try to update it, which means detecting the files that
	#   have changed and store them only, to .tar.gz/.bz2 files.
	#   This can only be proposed if a sda1.RecFiles.txt has been found.
	#
	if(-d $SRC."/".$New_Image)
	{
	    LOG("* There's already a [".$SRC."/".$New_Image."] directory...\n");
	    LOG("  Has the user provided a Already_Existing_Image param ?\n");

	    my $Found_RecFiles = 0;
	    {
		opendir(DIR, $SRC."/".$New_Image);
		my(@files) = readdir(DIR);
		closedir(DIR);
		foreach(@files)
		{
		    if(m/\.RecFiles\.txt$/i)
		    {
			++ $Found_RecFiles;
			last;
		    }
		}
	    }

	    if(defined($P{Already_Existing_Image})
	       && ($P{Already_Existing_Image} =~/Update/i
		   || $P{Already_Existing_Image} =~/Replace/i
		   || $P{Already_Existing_Image} =~/Rename/i))
	    {
		LOG("  Yes! Worth [".$P{Already_Existing_Image}."]\n");

		if($P{Already_Existing_Image} =~/Update/i)
		{
		    if(! $Found_RecFiles)
		    {
			LOG("  An Update is impossible, as there's no RecFiles.txt\n");

			if($P{Already_Existing_Image} =~/Replace/i)
			{
			    LOG("  The user said Replace should be OK too... good\n");
			    $P{Already_Existing_Image} = 'Replace';
			}
			elsif($P{Already_Existing_Image} =~/Rename/i)
			{
			    LOG("  The user said Rename should be OK too... good\n");
			    $P{Already_Existing_Image} = 'Rename';
			}
			else
			{
			    LOG("  We'll have to ask, as no 2nd choice was provided\n");
			    $P{Already_Existing_Image} = '';
			}
		    }
		    else
		    {
			LOG("  The Update should be feasible.\n");
			$P{Already_Existing_Image} = 'Update';
		    }
		}
		else
		{
		    if($P{Already_Existing_Image} =~/Replace/i)
		    {
			$P{Already_Existing_Image} = 'Replace';
		    }
		    elsif($P{Already_Existing_Image} =~/Rename/i)
		    {
			$P{Already_Existing_Image} = 'Rename';
		    }
		    else
		    {
			$P{Already_Existing_Image} = '';
		    }
		}
	    }
	    else
	    {
		$P{Already_Existing_Image} = '';
	    }

	    unless($P{Already_Existing_Image})
	    {
		LOG("  No; let's ask what to do\n");

		my $cmd = 'dialog --colors --menu "\Zb\ZnAn image called ['
		    .$New_Image.'] has been found in your directory. What should'
		    .' PING do ?\n\n" 12 50 3 '
		    .' "Rename and keep the old image" ""'
		    .' "Replace the old one" ""';
		if($Found_RecFiles)
		{
		    $cmd .= ' "Update the image that has been found" ""';
		}
		$cmd .= ' 2>'.$TMPDIR.'/checklist.tmp';
		system($cmd);

		if(-z $TMPDIR."/checklist.tmp")
		{
		    Quit();
		}

		open(DB, $TMPDIR."/checklist.tmp");
		while(<DB>)
		{
		    if(m/^Replace/i)
		    {
			$P{Already_Existing_Image} = 'Replace';
			last;
		    }
		    elsif(m/^Rename/i)
		    {
			$P{Already_Existing_Image} = 'Rename';
			last;
		    }
		    elsif(m/^Update/i)
		    {
			$P{Already_Existing_Image} = 'Update';
			last;
		    }
		    else
		    {
			Quit();
		    }
		}
		close(DB);
		unlink($TMPDIR."/checklist.tmp");

		LOG("  Chosen action: [".$P{Already_Existing_Image}."]\n");
	    }

	    if($P{Already_Existing_Image} eq 'Rename')
	    {
		my $Date = Date();
		$Date =~s/\D//g;
		LOG("  * Renaming old [".$SRC."/".$New_Image."] to [(...).OLD.".$Date."]\n");
		rename($SRC."/".$New_Image, $SRC."/".$New_Image.".OLD.".$Date);
	    }
	    elsif($P{Already_Existing_Image} eq 'Replace')
	    {
		LOG("  * Deleting old [".$SRC."/".$New_Image."] directory\n");
		Exec_Log("rm -fr \"".$SRC."/".$New_Image."\"", 4);
	    }
	}

	unless(-d $SRC."/".$New_Image)
	{
	    LOG("* Creating dir [".$SRC."/".$New_Image."]\n");
	    mkdir($SRC."/".$New_Image, 0755);
	}

	unless(-d $SRC."/".$New_Image)
	{
	    LOG("  ! I've been unable to create dir [".$SRC."/".$New_Image."]\n");
	    LOG("    There's probably a problem of space or permissions here.\n");
	    LOG("    No way to make a backup... quitting.\n");
	    sleep($FAILED_SLEEP);
	    Quit();
	}

	# Handling the case of a $Dev being worth cciss/c0d0 (HP SmartArray)...
	# + rd + ida + mapper. We need a $SRC/$New_Image/cciss/ directory.
	#
	foreach(@Parts_To_Backup)
	{
	    if(m/\//)
	    {
		my $tmp = $_;
		$tmp =~s/\/[^\/]+$//;
		if(! -d $SRC."/".$New_Image."/".$tmp)
		{
		    LOG("* Creating dir [".$SRC."/".$New_Image."/".$tmp."]\n");
		    mkdir($SRC."/".$New_Image."/".$tmp, 0755);
		}
	    }
	}

	# BIOS first
	#
	LOG("* Backuping bios\n");
	Exec_Log("cmospwd -w \"".$SRC."/".$New_Image."/bios\"", 2);

	# Keep a file with the drives(s) partition(s) list
	#
	LOG("* Keep the drive(s) partition(s) list\n");
	LOG("  => File \"".$SRC."/".$New_Image."/HDD_Look.txt\"\n");
	open(OUT, ">".$SRC."/".$New_Image."/HDD_Look.txt");
	print OUT HDD_Exact_Look(\@Dev_Rich);
	close(OUT);

	# Doing the backup of the partitions
	#
	foreach my $P (@Parts_To_Backup)
	{
	    LOG("* Backuping partition [/dev/".$P."]\n");

	    # Dell parts... don't allow them for storage if the user
	    # asked for help
	    #
	    # Disk /dev/hda: 85.8 GB, 85899345920 bytes
	    # 255 heads, 63 sectors/track, 10443 cylinders
	    # Units = cylinders of 16065 * 512 = 8225280 bytes
	    #
	    #    Device Boot    Start     End     Blocks   Id  System
	    # /dev/hda1             1       5      40131   de  Dell Utility
	    # /dev/hda2   *         6    9268   74405047+   7  HPFS/NTFS
	    # /dev/hda3          9269    9725    3670852+  db  CP/M / CTOS / ...
	    #
	    if($HELP_DELL && Is_Dell_Type(Part_Type("/dev/".$P)))
	    {
		LOG("  Don't backup this Dell-made part [/dev/".$P."] (Help Dell)\n");
		next;
	    }

	    # If the device is classical, part to backup is like sda1
	    # => just keep the letters.
	    # If cciss/rd/ida, part to backup is like cciss/c0d0p1, and
	    # device is cciss/c0d0.
	    #
	    LOG("  * Backuping first sectors of [/dev/".$P."]'s device\n");

	    my $HDD = HDD_Name($P);
	    LOG("    HDD: [".$HDD."]\n");

	    if(! -e $SRC."/".$New_Image."/".$HDD)
	    {
		Exec_Log("dd if=/dev/".$HDD." of=".$TMPDIR."/aaa count=64 bs=512;"
			 ." mv -f ".$TMPDIR."/aaa \"".$SRC."/".$New_Image."/".$HDD."\"", 4);
	    }


	    # Now storing the partition itself
	    #
	    # HP SmartArray => there will be a /dev/cciss/c0d0 device,
	    # and /dev/cciss/c0d0p1, p2, ... filesystems. The last digit must
	    # be removed for the parsing of the fdisk command to succeed.
	    # Disk /dev/cciss/c0d0: 73.3 GB, 73372631040 bytes
	    # Idem for ida and rd (RAID).
	    #
	    LOG("  * Now storing the [/dev/".$P."] partition\n");

	    # Before storing anything, remove any unwanted space-consuming file
	    #
	    LOG("    Checking [/dev/".$P."] for pagefile.sys, hiberfil.sys and swapfile.sys to remove\n");

	    unless(defined($P{Suppress_RootSys_Files}))
	    {
		Ask_If_Suppress_RootSys_Files();
	    }
	    if(YES($P{Suppress_RootSys_Files}))
	    {
		my $Type = Part_Type($P);
		LOG("      [/dev/".$P."]'s type: [".$Type."]\n");

		Umount("/mnt/win");
		Mount("/dev/".$P, "/mnt/win", "RW");

		foreach my $file ("pagefile.sys", "hiberfil.sys", "swapfile.sys")
		{
		    if(-e "/mnt/win/".$file)
		    {
			LOG("      Removing [".$file."]\n");
			Exec_Log("chmod 0666 /mnt/win/".$file."; rm -f /mnt/win/".$file, 6);
		    }
		    else
		    {
			LOG("      No [".$file."] to delete\n");
		    }
		}

		Umount("/mnt/win");
	    }
	    else
	    {
		LOG("      Unwanted.\n");
	    }


	    # It can be interesting to reduce the size of the partition
	    # before storing it. Thus, it's possible to restore it later
	    # into a smaller partition. Note that even if we decide later
	    # to restore into a equally-big or bigger partition, PING will
	    # always try to maximize the size of the filesystem at the end.
	    #
	    LOG("  * Minimizing the filesystem of [/dev/".$P."]\n");

	    if(YES($P{Minimize_Before_Storing}))
	    {
		LOG("    Estimating [/dev/".$P."] future size\n");
		my $New_Size = Part_Minimum_Size("/dev/".$P);
		LOG("    We can reduce to [".$New_Size."]\n");

		if($New_Size)
		{
		    LOG("    Resizing to [".$New_Size."] bytes!!\n");

# Over since 2015.
#		    my $New_Size_Cyl =
#			int($New_Size / ($Dev_Rich[0]->{Heads}
#					 * $Dev_Rich[0]->{Sectors_Track}
#					 * $Dev_Rich[0]->{BIOS_Sector_Size}));
#		    LOG("    - well, to [".$New_Size_Cyl."] cylinders\n");

		    my $New_Size_Sectors = int($New_Size / $Dev_Rich[0]->{BIOS_Sector_Size}) + 1;
		    LOG("    - well, to [".$New_Size_Sectors."] sectors\n");

		    if(FS_Resize($P, $New_Size_Sectors, $New_Size))
		    {
			LOG("    ! We could not resize that filesystem.\n");
			LOG("      Maybe not a drama.\n");
		    }
		    else
		    {
			LOG("    The resizing seems OK. Good. Go on.\n");

			# We now have to use fdisk to modify the size of
			# the partition accordingly to what ntfsresize has done.
			# fdisk is so hard to use in batch-mode that the best
			# way is to destroy all parts, and re-create them.
			#
			# We've got to set /dev/$P to $New_Size bytes.
			#
			# $New_Size bytes means $New_Size / (nb heads x
			#   nb sectors by track x 512) blocks -- this was OK with
			#   fdisk prior to 2015! now, fdisk wants sectors.
			#
			# So, $New_Size bytes means $New_Size / 512 sectors.
			#
			my $tmp_End = '';
			my $tmp_Sectors = '';
			foreach my $D (@Dev_Rich)
			{
			    next unless($D->{Dev} eq $HDD);

			    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
			    {
				next unless($D->{Parts}->[$i] eq $P);

				LOG("    Old fdisk start for [".$P."]: ["
				    .$D->{Start}->[$i]."]\n");
				LOG("    Old fdisk end for [".$P."]: ["
				    .$D->{End}->[$i]."]\n");
				LOG("    Old fdisk nb of sectors for [".$P."]: ["
				    .$D->{Sectors}->[$i]."]\n");

				$tmp_Sectors = $D->{Sectors}->[$i];
				$tmp_End = $D->{End}->[$i];

				$D->{End}->[$i] = $D->{Start}->[$i]
				    + int($New_Size / $D->{BIOS_Sector_Size});

				$D->{Sectors}->[$i] = $D->{End}->[$i] - $D->{Start}->[$i];
				$D->{Size}->[$i] = $D->{Sectors}->[$i] * $D->{BIOS_Sector_Size};

				LOG("    New fdisk end for [".$P."]: ["
				    .$D->{End}->[$i]."]\n");
				LOG("    New fdisk nb of sectors for [".$P."]: ["
				    .$D->{Sectors}->[$i]."]\n");
				LOG("    New fdisk size of [".$P."]: [".$D->{Size}->[$i]."]\n");
			    }
			}

			Delete_All_Parts($HDD, \@Dev_Rich);
			Recreate_All_Parts($HDD, \@Dev_Rich);

			LOG("    HDD Description after minimizing (Dev_Rich)\n");
			HDD_Describe(\@Dev_Rich);

			if($tmp_Sectors && $tmp_End)
			{
			    foreach my $D (@Dev_Rich)
			    {
				next unless($D->{Dev} eq $HDD);

				for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
				{
				    next unless($D->{Parts}->[$i] eq $P);

				    LOG("    Old fdisk start for [".$P."]: ["
					.$D->{Start}->[$i]."]\n");
				    LOG("    Old fdisk end for [".$P."]: ["
					.$D->{End}->[$i]."]\n");
				    LOG("    Old fdisk nb of sectors for [".$P."]: ["
					.$D->{Sectors}->[$i]."]\n");
				    LOG("    Old fdisk size of [".$P."]: ["
					.($D->{Sectors}->[$i] * $D->{BIOS_Sector_Size})."]\n");

				    $D->{Sectors}->[$i] = $tmp_Sectors;
				    $D->{End}->[$i] = $tmp_End;
				    $D->{Size}->[$i] = $tmp_Sectors * $D->{BIOS_Sector_Size};

				    LOG("    New fdisk end for [".$P."]: ["
					.$D->{End}->[$i]."]\n");
				    LOG("    New fdisk nb of sectors for [".$P."]: ["
					.$D->{Sectors}->[$i]."]\n");
				    LOG("    New fdisk size of [".$P."]: [".$D->{Size}->[$i]."]\n");
				}
			    }
			}

			LOG("    HDD Description before minimizing (Dev_Rich)\n");
			HDD_Describe(\@Dev_Rich);

			++ $Have_Minimized_Before_Storing;
			push(@Minimized_Devices, $HDD);
		    }
		}
		else
		{
		    LOG("    Part FS not handled => no minimizing.\n");
		}
	    }
	    else
	    {
		LOG("    Not wanted.\n");
	    }


	    # Storing first sectors of the part (they may include the boot
	    # sector sometimes, and the definition of the volume if LVM).
	    #
	    LOG("  * Storing first sectors of part [/dev/".$P."]\n");

	    if(YES($P{Zsplit_Preferred}))
	    {
		LOG("    Zsplit will be preferred to partimage. So, skip this step.\n");
	    }
	    else
	    {
		Exec_Log("dd if=/dev/".$P." of=".$TMPDIR."/aaa count=20 bs=512;"
			 ." mv -f ".$TMPDIR."/aaa \"".$SRC."/".$New_Image."/".$P.".first_sectors\"", 4);

		# If dd didn't even record 20x512 bytes, no need to go on,
		# we took everything (probably a ext'd).
		#
		# This is not true as far as curlftpfs is concerned, because
		# the program acts as a daemon, and leaves false 0-byte-long files.
		#
		my $Size = (stat($SRC."/".$New_Image."/".$P.".first_sectors"))[7];
		LOG("    dd has recorded [".$Size."] octets\n");
		if($Size < 20*512)
		{
		    LOG("    This is less than asked; no more data to record"
			." on this part, next\n");
		    if(YES($P{FTP_Preferred}))
		    {
			LOG("    Well, ftp is used... don't take it into account\n");
		    }
		    else
		    {
			next;
		    }
		}
	    }


	    # Storing the partition now
	    #
	    LOG("  * Storing the part [/dev/".$P."] itself\n");

	    # Modify the boot.ini file if this is a Dell system, so restored
	    # images will boot the right partition. We'll set it back afterwards.
	    #
	    # [boot loader]
	    # timeout=30
	    # default=multi(0)disk(0)rdisk(0)partition(2)\WINDOWS
	    # [operating systems]
	    # multi(0)disk(0)rdisk(0)partition(2)\WINDOWS="Microsoft Windows XP Home Edition" /fastdetect
	    #
	    if($HELP_DELL)
	    {
		LOG("    First, helping Dell. Modifying boot.ini ...\n");
		Umount("/mnt/win");
		Mount("/dev/".$P, "/mnt/win", "RW");
		my $Bootini = Find_File_Whatever_Case("/mnt/win", "boot.ini");
		if($Bootini)
		{
		    Exec_Log("cp -f /mnt/win/".$Bootini." ".$TMPDIR."/.");
		    my $New = "";
		    open(S, $TMPDIR."/".$Bootini);
		    open(T, ">".$TMPDIR."/".$Bootini.".new");
		    while(<S>)
		    {
			s/partition\(2\)/partition\(1\)/i;
			print T $_;
		    }
		    close(S);
		    close(T);
		    Exec_Log("cp -fv ".$TMPDIR."/".$Bootini.".new /mnt/win/".$Bootini);
		}
		Umount("/mnt/win");
	    }

	    if(Part_Type($P) eq "8e")
	    {
		LOG("    Well, no we won't (Part type: ["
		    .ID_To_Type(Part_Type($P))."] = LVM)\n");
		LOG("    You should store the contents instead.\n");
	    }
	    if(Part_Type($P) eq "82")
	    {
		LOG("    Well, no we won't (Part type: ["
		    .ID_To_Type(Part_Type($P))."] = Swap)\n");
	    }
	    else
	    {
		# Two methods: either update a preexisting image, then just
		# tar the new files, either create partimage/zsplit/targz
		# global files.
		#
		if(-e $SRC."/".$New_Image."/".$P.".RecFiles.txt"
		   && $P{Already_Existing_Image} =~/Update/i)
		{
		    LOG("    There's a [".$SRC."/".$New_Image."/".$P.".RecFiles.txt] file\n");
		    LOG("      and the user wants an Update. Let's do it.\n");

		    unless($P{Store_MD5})
		    {
			LOG("      Rectifying param Store_MD5 to 0 (not so obvious)\n");
			$P{Store_MD5} = 0;
		    }

		    # Find out what has changed
		    #
		    my(%Sizes) = ();
		    my(%MD5) = ();
		    open(R, $SRC."/".$New_Image."/".$P.".RecFiles.txt");
		    while(<R>)
		    {
			s/^\s*//;
			s/\s*$//;
			my(@F) = split(/\;/, $_);
			$Sizes{$F[0]} = (defined($F[1]) ? $F[1]:-1);
			$MD5{$F[0]} = (defined($F[2]) ? $F[2]:-1);
		    }
		    close(R);

		    my(@To_Delete) = ();
		    my(@To_Update) = ();
		    my(@To_Add) = ();

		    Mount("/dev/".$P, "/mnt/win", "");

		    my $cnt = 0;

		    sub rec_Update_MD5
		    {
			my($dir) = shift || '';
			return() unless($dir && -e $dir);

			opendir(DIR, $dir);
			my(@files) = readdir(DIR);
			closedir(DIR);

			foreach my $file (@files)
			{
			    next if($file =~/^\.{1,2}$/);

			    ++ $cnt;
			    if(($cnt / 1000) == int($cnt / 1000))
			    {
				LOG("      [".$cnt."] file details checked\n");
			    }

			    my $path = $dir."/".$file;
			    $path =~s/^\/mnt\/win//;

			    if(-d $dir."/".$file)
			    {
				unless(defined($Sizes{$path}))
				{
				    push(@To_Add, $path);
				}
				rec_Update_MD5($dir."/".$file);
			    }
			    else
			    {
				if(defined($Sizes{$path}))
				{
				    if((stat($dir."/".$file))[7] eq $Sizes{$path})
				    {
					if(MD5($dir."/".$file) ne $MD5{$path})
					{
					    push(@To_Update, $path);
					}
				    }
				    else
				    {
					push(@To_Update, $path);
				    }
				}
				else
				{
				    push(@To_Add, $path);
				}
			    }
			}
		    }

                    rec_Update_MD5("/mnt/win");

                    foreach(keys(%Sizes))
                    {
			unless(-e "/mnt/win/$_")
			{
			    push(@To_Delete, $_);
			}
		    }

		    LOG("      Nb of removed files: [".($#To_Delete + +1)."]\n");
		    LOG("      Nb of added files:   [".($#To_Add + +1)."]\n");
		    LOG("      Nb of updated files: [".($#To_Update + +1)."]\n");

                    # Update the xxx.RecFiles.txt file
                    #
                    open(D, ">".$SRC."/".$New_Image."/".$P.".RecFiles.txt.new");
		    open(S, $SRC."/".$New_Image."/".$P.".RecFiles.txt");
		    while(<S>)
		    {
		        s/^\s*//;
		        s/\s*$//;
		        my(@fields) = split(/\;/, $_);
		        my $flag = 0;
		        foreach my $T (@To_Delete)
		        {
			    if($T eq $fields[0])
			    {
				++ $flag;
				last;
			    }
		        }
		        unless($flag)
		        {
			    my $flag2 = 0;
			    foreach my $U (@To_Update)
			    {
				if($U eq $fields[0])
				{
				    ++ $flag2;
				    last;
				}
			    }
			    if($flag2)
			    {
				print D $fields[0].";".(stat("/mnt/win/".$fields[0]))[7]
				    .";".MD5("/mnt/win/".$fields[0])."\n";
			    }
			    else
			    {
				print D "$_\n";
			    }
		        }
		    }
		    close(S);
		    foreach(@To_Add)
		    {
		        if(-d "/mnt/win/".$_)
		        {
			    print D $_."\n";
		        }
		        else
		        {
			    print D $_.";".(stat("/mnt/win/".$_))[7].";"
				.MD5("/mnt/win/".$_)."\n";
		        }
		    }
                    close(D);

                    if(-e $SRC."/".$New_Image."/".$P.".RecFiles.txt.old")
                    {
                        unlink($SRC."/".$New_Image."/".$P.".RecFiles.txt.old");
                    }
                    rename($SRC."/".$New_Image."/".$P.".RecFiles.txt",
			   $SRC."/".$New_Image."/".$P.".RecFiles.txt.old");
                    rename($SRC."/".$New_Image."/".$P.".RecFiles.txt.new",
			   $SRC."/".$New_Image."/".$P.".RecFiles.txt");

                    # Tar the added / updated files
                    #
                    my $inc = 0;
                    my $inc2 = $inc;
                    while(length($inc2) < 3)
                    {
                        $inc2 = "0".$inc2;
                    }
                    while(-e $SRC."/".$New_Image."/".$P.".".$inc2.".tar.gz"
                          || -e $SRC."/".$New_Image."/".$P.".".$inc2.".tar.bz2")
                    {
                        ++ $inc;
                        $inc2 = $inc;
                        while(length($inc2) < 3)
                        {
			    $inc2 = "0".$inc2;
                        }
                    }
                    foreach(@To_Add, @To_Update)
                    {
			my $X = $_;
			$X =~s/^\///;
                        system("cd /mnt/win; "
			       ."tar rvf \"".$SRC."/".$New_Image."/".$P.".".$inc2.".tar\" \"".$X."\"");
                    }
                    Exec_Log((($Compression_Type eq "gzip") ? "gzip -4":"bzip2 -9")
			     ." \"".$SRC."/".$New_Image."/".$P.".".$inc2.".tar\"");

		    Umount("/mnt/win");
		}
		else
		{
		    LOG("    No Update, but an image creation for part [/dev/".$P."]\n");

                    # Cases like mapper/fedora_host-usr.000 ...
                    #
                    if($P =~/\//)
                    {
			LOG("    First create the dest dir for [".$P."]\n");
			my $dir = $SRC."/".$New_Image."/".$P;
			$dir =~s/\/[^\/]+$//;
			$dir =~s/\/$//;
			unless(-d $dir)
			{
			    LOG("      Creating dir [".$dir."]\n");
			    Exec_Log("mkdir -p \"".$dir."\"");
			}
		    }

		    if($SRC =~/dos/i)
		    {
			Umount("/mnt/dos");
			Mount("/dev/".$Part_For_Storage, "/mnt/dos", "RW");
		    }

		    # Trying partimage first
		    # ...except if we've got a "Dell utility" partition. For this
		    #    one, use zsplit, even though they MIGHT be standard FAT16
		    #    parts which ID might have been renamed to 'de' (they are
		    #    always small anyway, so don't bother too much).
		    #
		    if(Part_Type($P) eq "de")
		    {
			LOG("    This is a Dell Utility part. Don't use partimage!\n");
		    }
		    elsif(YES($P{Zsplit_Preferred}))
		    {
			LOG("    The user wants zsplit to be preferred."
			    ." Don't use partimage!\n");
		    }
		    elsif(YES($P{Tarball_Preferred}))
		    {
			LOG("    The user wants tar+gz to be preferred."
			    ." Don't use partimage!\n");
		    }
                    elsif(YES($P{Partclone_Preferred}))
                    {
			LOG("    The user wants partclone to be preferred."
			    ." Don't use partimage!\n");
                    }
                    elsif(YES($P{FSArchiver_Preferred}))
                    {
			LOG("    The user wants fsarchiver to be preferred."
			    ." Don't use partimage!\n");
                    }
		    else
		    {
			my $cmd = "partimage -f3 -z";
			if($Compression_Type eq 'bzip2')
			{
			    $cmd .= "2";
			}
			elsif($Compression_Type eq 'no compression')
			{
			    $cmd .= "0";
			}
			else
			{
			    $cmd .= "1";    # defaulted gzip anyway
			}
			$cmd .= " -b -c -d -V".$PARTIMAGE_SPLIT." -o"
			    ." save /dev/".$P." \"".$SRC."/".$New_Image."/".$P."\";"
			    ." sleep ".$PARTIMAGE_SLEEP."; reset";
			LOG("    Cmd: [".$cmd."]\n");
			system($cmd);

			my $out = `tail --lines=15 /var/log/partimage-debug.log 2>&1`;
			LOG("    Output: (...) [".$out."]\n");

			# Clean temp files (due to *** glibc detected *** failures...)
			# (Careful with the rd/ida/cciss/mapper subdirs)
			#
			{
			    my $Path = $SRC."/".$New_Image;
			    if($P =~/\//)
			    {
				my $tmp = $P;
				$tmp =~s/\/[^\/]+$//;
				$Path .= "/".$tmp;
			    }
			    opendir(DIR, $Path);
			    my(@Files) = readdir(DIR);
			    closedir(DIR);
			    foreach(@Files)
			    {
				if(m/^pi.*\.tmp$/i)
				{
				    LOG("    Deleting a remaining tmp file: [".$_."]\n");
				    unlink($Path."/".$_);
				}
			    }
			}

			# If output contains FAILED (last line), suppress
			# partimage-made files, so partclone will be used instead.
			# Example of filenames: sda1.000, sda1.001...
			#
			LOG("    Has partimage succeeded ?\n");
			if($out =~/FAILED/ || -z $SRC."/".$New_Image."/".$P.".000")
			{
			    LOG("      No! we must suppress partimage-made files, if any\n");
			    sleep(1);

			    opendir(DIR, $SRC."/".$New_Image);
			    my(@files) = readdir(DIR);
			    closedir(DIR);

			    foreach my $f (@files)
			    {
				if($f =~/^\.{1,2}$/)
				{
				    next;
				}
				if($f =~/^$P\.\d{3}$/)
				{
				    LOG("        Suppress: [".$SRC."/".$New_Image."/".$f."]\n");
				    unlink($SRC."/".$New_Image."/".$f);
				}
			    }

			    # Not enough, we've missed mapper/xxx.000-like files
			    #
			    if(-e $SRC."/".$New_Image."/".$P.".000")
			    {
				LOG("        Suppress: [".$SRC."/".$New_Image."/".$P.".000]\n");
				unlink($SRC."/".$New_Image."/".$P.".000");
			    }
			}
			else
			{
			    LOG("      Yes!\n");
			}
		    }

                    # If partimage has failed (LVM parts, for example, or reiserfs
                    # or btrfs or ext4 or just any reason), and unless the user has
                    # set Zsplit_Preferred to Y, try to use partclone.
                    #
		    if(! -e $SRC."/".$New_Image."/".$P.".000" && ! YES($P{Tarball_Preferred})
                        && ! YES($P{Zsplit_Preferred}) && ! YES($P{FSArchiver_Preferred}))
		    {
			LOG("    ! Partimage has not written any partition.\n");
			LOG("      We'll use partclone.\n");

			foreach("partclone.log", "partclone.stderr")
			{
			    if(-e "/var/log/".$_)
			    {
				unlink("/var/log/".$_);
			    }
			}

			my $PEXT = "";
			my $FS_Type = FS_Type($P);
			LOG("      FS Type of [".$P."]: [".$FS_Type."]\n");

			foreach("ext4", "reiser4", "btrfs", "xfs", "ufs", "vmfs",
				"ext2", "ext3", "fat32", "ntfs")
			{
			    if(lc($FS_Type) eq lc($_))
			    {
				$PEXT = ".".$_;
			    }
			}

			if($PEXT)
			{
			    # Set no -o, so to use standard output
			    my $cmd = "(partclone".$PEXT." -R -L /var/log/partclone.log "
				." -c -I -F -s /dev/".$P." ";

			    my $EXT = "";
			    if($Compression_Type eq "gzip")
			    {
				$cmd .= "|gzip -4 -";
				$EXT = ".gz";
			    }
			    elsif($Compression_Type eq "bzip2")
			    {
				$cmd .= "|bzip2 -9 -";
				$EXT = ".bz2";
			    }
			    $cmd .= "|split -b ".$PARTCLONE_SPLIT." -"
				." \"".$SRC."/".$New_Image."/".$P.".img".$EXT.".x\""
				.") 2>/var/log/partclone.stderr";

			    $cmd =~s/\/\.\//\//g;
			    $cmd =~s/\/+/\//g;

			    LOG("    Cmd: [".$cmd."]\n");
			    system($cmd);

			    if(-e "/var/log/partclone.stderr")
			    {
				LOG("    Stderr! Contains:\n");
				my $out = `tail --lines=15 /var/log/partclone.stderr 2>&1`;
				LOG("      [".$out."]\n");
			    }
			    if(-e "/var/log/partclone.log")
			    {
				LOG("    Output:\n");
				my $out = `tail --lines=15 /var/log/partclone.log 2>&1`;
				LOG("      [".$out."]\n");

				if($out =~/successfully/i)
				{
				    LOG("      Success!\n");
				}
				else
				{
				    LOG("      Failed!\n");
				    LOG("      Removing failed output files\n");
				    opendir(DIR, $SRC."/".$New_Image);
				    my(@files) = readdir(DIR);
				    closedir(DIR);
				    foreach(@files)
				    {
					if(m/$P\.img$EXT\.x/)
					{
					    LOG("      - Removing [".$SRC."/".$New_Image."/".$_."]\n");
					    unlink($SRC."/".$New_Image."/".$_);
					}
				    }

				    # Not enough, we've missed mapper/xxx.000-like files
				    #
				    system("rm -f -v $SRC/$New_Image/$P.img$EXT.x*");
				}
			    }
			}
			else
			{
			    LOG("      We could not use partclone with such a FS Type.\n");
			}
		    }

                    # If partimage and partclone have failed (any reason), and unless
                    # the user has set Zsplit_Preferred to Y, try to use fsarchiver.
                    #
		    if(! -e $SRC."/".$New_Image."/".$P.".000"
		       && ! -e $SRC."/".$New_Image."/".$P.".img.xaa"
		       && ! -e $SRC."/".$New_Image."/".$P.".img.gz.xaa"
		       && ! -e $SRC."/".$New_Image."/".$P.".img.bz2.xaa"
		       && ! YES($P{Tarball_Preferred}) && ! YES($P{Zsplit_Preferred}))
		    {
			LOG("    ! Nor Partimage nor Partclone have written any partition.\n");
			LOG("      We'll use fsarchiver.\n");

			foreach("partimage.log", "partclone.log", "partclone.stderr")
			{
			    if(-e "/var/log/".$_)
			    {
				unlink("/var/log/".$_);
			    }
			}

			my $Z = 1;
			if($Compression_Type eq "gzip")
			{
			    $Z = 4;
			}
			elsif($Compression_Type eq "bzip2")
			{
			    $Z = 9;
			}

			my $cmd = "fsarchiver -v -z ".$Z." -s ".$FSARCHIVER_SPLIT
			    ." savefs \"".$SRC."/".$New_Image."/".$P.".fsa\" /dev/".$P
			    ." >/var/log/fsarchiver.log 2>&1 &";

			$cmd =~s/\/\.\//\//g;    # No x/./y
			$cmd =~s/\/+/\//g;       # No x//y

			LOG("    Cmd: [".$cmd."]\n");
			my $out = `$cmd`;
			LOG("    Out: [".$out."]\n");

			# * files successfully processed:....regfiles=90135, directories=22466, symlinks=69, hardlinks=23648, specials=1
			# * files with errors:...............regfiles=0, directories=0, symlinks=0, hardlinks=0, specials=0

                        system("tail -f /var/log/fsarchiver.log &");

                        my $cnt = 0;
                        while(++ $cnt)
                        {
                            if(Is_PName_Running("fsarchiver"))
                            {
                                sleep(10);
                                next;
                            }
                            else
                            {
                                KILL("tail");
                                last;
                            }
                        }

			my $RSLT_GOOD = 0;
			my $RSLT_BAD = 0;
			if(-e "/var/log/fsarchiver.log")
			{
			    open(L, "/var/log/fsarchiver.log");
			    while(<L>)
			    {
				if(m/^\s*\*\s*files successfully processed\:(.*)/)
				{
				    my(@cnts) = split(/\,/, $_);
				    foreach my $c (@cnts)
				    {
					$c =~s/\D//g;
					$RSLT_GOOD += $c;
				    }
				}
				if(m/^\s*\*\s*files with errors\:(.*)/)
				{
				    my(@cnts) = split(/\,/, $_);
				    foreach my $c (@cnts)
				    {
					$c =~s/\D//g;
					$RSLT_BAD += $c;
				    }
				}
			    }
			    close(L);
			}

			LOG("    TOTAL Well processed objects: [".$RSLT_GOOD."]\n");
			LOG("    TOTAL Missed objects:         [".$RSLT_BAD."]\n");

			if(($RSLT_BAD == 0 && $RSLT_GOOD > 0)
			   || ($RSLT_BAD > 0 && $RSLT_GOOD > 0 && $RSLT_GOOD > 1000 * $RSLT_BAD)
			   || ($RSLT_GOOD > 0 && $RSLT_BAD < 10))
			{
			    LOG("  FSArchiver seems to have succeeded (possibly generous!)\n");
			    sleep($README_SLEEP);
			}
			else
			{
			    LOG("  ! FSArchiver has failed!\n");
			    LOG("    Removing misleading incomplete files\n");
			    sleep($FAILED_SLEEP);

			    opendir(DIR, $SRC."/".$New_Image);
			    my(@files) = readdir(DIR);
			    closedir(DIR);
			    foreach(@files)
			    {
				if(m/$P\.fsa$/ || m/$P\.f\d\d$/)
				{
				    LOG("      - Removing [".$SRC."/".$New_Image."/".$_."]\n");
				    unlink($SRC."/".$New_Image."/".$_);
				}
			    }

			    # Not enough, we've missed mapper/xxx.000-like files
			    #
			    system("rm -f -v $SRC/$New_Image/$P.f*");
			}
		    }

		    # If partimage and partclone have failed (LVM parts,
                    # for example, or just any reason), or if the user
                    # has set Zsplit_Preferred to Y, use zsplit. Then,
                    # of course, the dd-ed 20 first sectors are
		    # redundant and must be deleted.
		    #
		    if(! -e $SRC."/".$New_Image."/".$P.".000"
		       && ! -e $SRC."/".$New_Image."/".$P.".img.xaa"
		       && ! -e $SRC."/".$New_Image."/".$P.".img.gz.xaa"
		       && ! -e $SRC."/".$New_Image."/".$P.".img.bz2.xaa"
		       && ! -e $SRC."/".$New_Image."/".$P.".fsa"
		       && ! YES($P{Tarball_Preferred}) && ! YES($P{FSArchiver_Preferred}))
		    {
			LOG("    ! Nor Partimage, nor Partclone nor fsarchiver have written"
			    ." any partition.\n");
			LOG("      We'll use zsplit. That'll take a while, much space, BUT will work.\n");
			sleep($README_SLEEP);

			my $cmd = "zsplit -s ".$ZSPLIT_SPLIT."M -N ".$P." -o"
			    ." \"".$SRC."/".$New_Image."\" -d /dev/".$P;

			LOG("    Cmd: [".$cmd."]\n");
			system($cmd);

			if(-e "./debug.log")
			{
			    my $out = "";
			    open(DB, "./debug.log");
			    while(<DB>)
			    {
				$out .= $_;
			    }
			    close(DB);
			    unlink("./debug.log");
			    LOG("    Output: [".$out."]\n");
			}
			if(-e $SRC."/".$New_Image."/".$P.".first_sectors")
			{
			    LOG("    Deleting [".$P.".first_sectors], now useless\n");
			    unlink($SRC."/".$New_Image."/".$P.".first_sectors");
			}
		    }

		    # Finally, use tar+gzip.
		    #
		    if(YES($P{Tarball_Preferred}))
		    {
			LOG("    Using tar+gzip to store the filesystem's contents.\n");
			Umount("/mnt/win");
			Mount("/dev/".$P, "/mnt/win", "");

			my $cnt = 0;
			open(TC, ">".$SRC."/".$New_Image."/".$P.".Tarballs.txt");

			my(@Dirs) = ();
			my(@Root_Files) = ();
			{
			    opendir(DIR, "/mnt/win");
			    my(@Files) = readdir(DIR);
			    closedir(DIR);
			    foreach(@Files)
			    {
				next if(m/\.{1,2}$/);
				if(-d "/mnt/win/".$_)
				{
				    push(@Dirs, $_);
				}
				else
				{
				    push(@Root_Files, $_);
				}
			    }
			}

			my $A = "";
			my $B = "";
			if($Compression_Type eq "gzip")
			{
			    $A = ".gz";
			    $B = "|gzip -1 -";
			}
			elsif($Compression_Type eq "bzip2")
			{
			    $A = ".bz2";
			    $B = "|bzip2 -9 -";
			}

			foreach my $Dir (@Dirs)
			{
			    my $Cnt = $cnt;
			    while(length($Cnt) < 3)
			    {
				$Cnt = "0".$Cnt;
			    }

			    LOG("      - Storing dir [".$Dir."] to [".$P.".".$Cnt.".tar".$A."]\n");

			    my $cmd = "cd /mnt/win; tar cf -"
				." \"$Dir\" $B >$SRC/$New_Image/$P.$Cnt.tar$A";

			    Exec_Log($cmd, 8);

			    print TC "$P.$Cnt.tar$A --- $Dir\n";
			    ++ $cnt;
			}

			# And the files in the root
			#
			my $Cnt = $cnt;
			while(length($Cnt) < 3)
			{
			    $Cnt = "0".$Cnt;
			}
			my $cmd = "cd /mnt/win; tar cf - ";
			foreach(@Root_Files)
			{
			    $cmd .= "\"".$_."\" ";
			}
			$cmd .= " >$SRC/$New_Image/$P.$Cnt.tar$A";
			Exec_Log($cmd, 8);

			print TC "$P.$Cnt.tar$A --- /\n";
			close(TC);

			Umount("/mnt/win");
		    }
		}

		# Now the partition has been recorded, it might be
		# interesting to store the MD5 checksum of all imaged
		# files, in order to be able to make incremental
		# backuping next time (updating an existing image).
		#
		LOG("    Will we store details about each included file ?\n");

		if(YES($P{Store_MD5}))
		{
		    LOG("      Yes!\n");
		    Mount("/dev/".$P, "/mnt/dos", "");

		    my $cnt = 0;
		    open(TC, ">".$SRC."/".$New_Image."/".$P.".RecFiles.txt");

		    sub rec_Store_MD5
		    {
			my($dir) = shift || '';
			return() unless($dir && -e $dir);

			opendir(DIR, $dir);
			my(@files) = readdir(DIR);
			closedir(DIR);

			foreach my $file (@files)
			{
			    next if($file =~/^\.{1,2}$/);

			    ++ $cnt;
			    if(($cnt / 1000) == int($cnt / 1000))
			    {
				LOG("      [".$cnt."] file details stored\n");
			    }

			    my $path = $dir."/".$file;
			    $path =~s/^\/mnt\/dos//;

			    if(-d $dir."/".$file)
			    {
				print TC $path."\n";
				rec_Store_MD5($dir."/".$file);
			    }
			    else
			    {
				print TC $path.";".(stat($dir."/".$file))[7].";"
				    .MD5($dir."/".$file)."\n";
			    }
			}
		    }

                    rec_Store_MD5("/mnt/dos");

		    close(TC);

		    Umount("/mnt/dos");
		}
		else
		{
		    LOG("      No!\n");
		}
	    }

	    if($HELP_DELL)
	    {
		LOG("    Finally, helping Dell. Restore original boot.ini ...\n");
		Mount("/dev/".$P, "/mnt/dos", "RW");
		my $Bootini = Find_File_Whatever_Case("/mnt/dos", "boot.ini");
		if($Bootini && -e $TMPDIR."/".$Bootini)
		{
		    Exec_Log("cp -fv ".$TMPDIR."/".$Bootini." /mnt/dos/.");
		}
		Umount("/mnt/dos");
	    }
	}

	# Finally, save a Dell user. We have saved only the part
	# containing the data. Now, why not tell PING that when it
	# restores the disk, it uses all available disk space ?
	#
	# Also, make sure saved files will be hda1 and not hda2.
	#
	if($HELP_DELL)
	{
	    LOG("* Helping Dell for a better restoration of this image...\n");
	    LOG("  => Preparing file ".$SRC."/".$New_Image."/HDD_Target.txt\n");

	    if($SRC =~/dos/i)
	    {
		Umount("/mnt/dos");
                Mount("/dev/".$Part_For_Storage, "/mnt/dos", "RW");
            }

	    my(@S_Dev_Rich) = ();
	    HDD_Get_From_Exact_Look($SRC."/".$New_Image."/HDD_Look.txt", \@S_Dev_Rich);

	    foreach my $D (@S_Dev_Rich)
	    {
		for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
		{
		    if($D->{Parts}->[$i] eq 'null')
		    {
			next;
		    }
		    if(Is_Dell_Type($D->{Types}->[$i]))
		    {
			$D->{Parts}->[$i] = 'null';
			$D->{Start}->[$i] = 'null';
			$D->{End}->[$i] = 'null';
			next;
		    }
		    else
		    {
			$D->{Start}->[$i] = 1;
			$D->{Parts}->[$i] = $D->{Dev}."1";
			$D->{Boot_Flags}->[$i] = 1;
		    }
		}
	    }

	    open(T, ">".$SRC."/".$New_Image."/HDD_Target.txt");
	    print T HDD_Exact_Look(\@S_Dev_Rich);
	    close(T);

	    opendir(DIR, $SRC."/".$New_Image);
	    my(@files) = readdir(DIR);
	    closedir(DIR);
	    foreach(@files)
	    {
		if(m/^(h|s)da2/)
		{
		    my $N = $_;
		    $N =~s/da2/da1/;
		    LOG("     Renaming [".$_."] to [".$N."]\n");
		    rename($SRC."/".$New_Image."/".$_, $SRC."/".$New_Image."/".$N);
		}
	    }

	    LOG("   Creating a blank [".$SRC."/".$New_Image."/Help_Dell] file,\n");
	    LOG("     so PING will know when restoring that the BS is KO\n");
	    open(D, ">".$SRC."/".$New_Image."/Help_Dell");
	    close(D);
	}
    }

    elsif($Entity =~/Blank_Local_Admin_Passwd/i)
    {
	LOG("* Blanking local admin's password!\n");

	foreach my $D (@Dev_Rich)
	{
	    foreach my $P (@{ $D->{Parts} })
	    {
		LOG("  * Trying to blank local admin's password on [/dev/".$P."]\n");

		LOG("    Mounting [/dev/".$P."]\n");
		Umount("/mnt/dos");
		Mount("/dev/".$P, "/mnt/dos", "RW");

		unless(Is_Mounted("/dev/".$P))
		{
		    LOG("      This part could not be mounted. Next.\n");
		    next;
		}

		my $SAM = "/mnt/dos";

		my $found = 0;
		opendir(DIR, $SAM);
		my @files = readdir(DIR);
		closedir(DIR);
		foreach(@files)
		{
		    if(m/^windows$/i)
		    {
			$SAM .= "/".$_;
			$found = 1;
			last;
		    }
		}
		unless($found)
		{
		    LOG("      No [windows] dir could be found. Next.\n");
		    next;
		}

		$found = 0;
		opendir(DIR, $SAM);
		@files = readdir(DIR);
		closedir(DIR);
		foreach(@files)
		{
		    if(m/^system32$/i)
		    {
			$SAM .= "/".$_;
			$found = 1;
			last;
		    }
		}
		unless($found)
		{
		    LOG("      No [system32] dir could be found. Next.\n");
		    next;
		}

		$found = 0;
		opendir(DIR, $SAM);
		@files = readdir(DIR);
		closedir(DIR);
		foreach(@files)
		{
		    if(m/^config$/i)
		    {
			$SAM .= "/".$_;
			$found = 1;
			last;
		    }
		}
		unless($found)
		{
		    LOG("      No [config] dir cound be found. Next.\n");
		    next;
		}

		$found = 0;
		opendir(DIR, $SAM);
		@files = readdir(DIR);
		closedir(DIR);
		foreach(@files)
		{
		    if(m/^SAM$/i)
		    {
			$SAM .= "/".$_;
			$found = 1;
			last;
		    }
		}
		unless($found)
		{
		    LOG("      No [SAM] file could be found. Next.\n");
		    next;
		}

		LOG("    Addressing SAM file [".$SAM."]\n");

		LOG("    Is local admin locked ?\n");
		my $cmd = "chntpw -l \"".$SAM."\" >".$TMPDIR."/BLA";
		LOG("    Cmd: [".$cmd."]\n");
		system($cmd);

		my $Status = 0;
		if(-e $TMPDIR."/BLA")
		{
		    open(DB, $TMPDIR."/BLA");
		    while(<DB>)
		    {
			if(m/\<Administrator\>/i && m/locked/i)
			{
			    ++ $Status;
			    last;
			}
		    }
		    close(DB);
		    unlink($TMPDIR."/BLA");
		}
		my $Unlock = "";
		if($Status)
		{
		    $Unlock = "y\n";
		    LOG("      It was locked.\n");
		}
		else
		{
		    LOG("      Was not.\n");
		}

		$cmd = "echo -e \"".$Unlock."*\ny\ny\n\"|chntpw -u Administrator ".$SAM;
		LOG("    Cmd: [".$cmd."]\n");
		system($cmd);

		LOG("    Unmounting [/mnt/dos]\n");
		Umount("/mnt/dos");
	    }
	}
    }
}
else
{
    # This is an image that is going to be restored.

    LOG("* Image restoration\n");

    my @Label_CMD = ();

    my(@F) = ();
    my(@FF) = ();
    my $Multi = 0;
    Read_Dir(\@F, \@FF, \$Multi);       # Will feed @F, @FF and $Multi

    LOG("  F:\n");
    foreach(@F)
    {
	LOG("  - [".$_."]\n");
    }
    LOG("  FF:\n");
    foreach(@FF)
    {
	LOG("  - [".$_."]\n");
    }

    # Only for logging purpose, get more info on files
    #
    LOG("* Get details about each file to restore (debug purpose)\n");
    foreach my $FF (@FF)
    {
	my $short = ".../".(split(/\//, $FF))[-1];
	LOG("  [".$short."] => size [".(stat($FF))[7]."]\n");
    }

    # If there's an HDD_Look.txt file, let's see what is inside...
    #
    my(@Image_Dev_Rich) = ();
    foreach my $FF (@FF)
    {
	if($FF =~/\/HDD_Look\.txt$/i)
	{
	    LOG("\n");
	    LOG("* There's an HDD_Look.txt file... get the info\n");
	    HDD_Get_From_Exact_Look($FF, \@Image_Dev_Rich);

	    LOG("\n");
	    LOG("* Info from the HDD_Look.txt file: (Image_Dev_Rich)\n");
	    HDD_Describe(\@Image_Dev_Rich);
	}
    }

    # Some users may not want to have the BIOS settings restored.
    # It's time to ask the user about this point.
    #
    foreach my $CurrFF (@FF)
    {
	if($CurrFF =~/\/bios$/i)
	{
	    LOG("* There's a [bios] file; what will we do with it ?\n");

	    if(defined($P{Replace_BIOS}))
	    {
		LOG("  There's a preconfig entry; worth [".$P{Replace_BIOS}."]\n");
	    }
	    else
	    {
		LOG("  There's no preconfig predefined info\n");

		if(defined($P{AUTO}) && $P{AUTO})
		{
		    LOG("  AUTO param set! don't ask, replace\n");
		    $P{Replace_BIOS} = 1;
		}
		else
		{
		    LOG("  AUTO param not set... let's ask the user\n");

		    my $cmd = 'dialog --colors --menu "\Zb\ZnBIOS settings have been'
			.' recorded on your image. Do you want them to be restored ?'
			.' If unsure, say NO.\n\n" 12 50 2 '
			.' "No" "" "Yes" "" 2>'.$TMPDIR.'/checklist.tmp';
		    system($cmd);

		    if(-z $TMPDIR."/checklist.tmp")
		    {
			Quit();
		    }

		    open(DB, $TMPDIR."/checklist.tmp");
		    while(<DB>)
		    {
			if(m/Y/i)
			{
			    $P{Replace_BIOS} = 1;
			    last;
			}
		    }
		    close(DB);
		    unlink($TMPDIR."/checklist.tmp");
		}
	    }

	    last;
	}
    }
    unless(YES($P{Replace_BIOS}))
    {
	$P{Replace_BIOS} = 0;
    }

    LOG("  Replace BIOS =>[".$P{Replace_BIOS}."]\n");

    # If there's another addon-*.tar.gz/bz2/xz/zip file, apply it now.
    #
    foreach my $CurrFF (@FF)
    {
	if($CurrFF =~/\/addon(\-|_).*\.tar\.(gz|bz2|xz)$/i || $CurrFF =~/\/addon(\-|_).*\.zip$/i)
	{
	    LOG("* There's a [addon-*.tar.*] file; unzip to /\n");
	    Exec_Log("cd /; ".Unzip($CurrFF), 2);
	}
    }

    # If there are new parameters specific to the chosen image, get them
    # and overwrite those passed either by the APPEND line of the kernel,
    # either by the system /etc/ping.conf ($PING_CONF) file.
    #
    foreach my $CurrFF (@FF)
    {
	if($CurrFF =~/\/ping\.conf$/i)
	{
	    LOG("* There's a [ping.conf] file; get parameters\n");

	    Get_Parameters($CurrFF, \@CONFIG_FIELDS, \%P);

	    foreach(@CONFIG_FIELDS)
	    {
		if(defined($P{$_}))
		{
		    LOG("  Param: [$_] = [".((m/^Passwd$/) ? "xxx":$P{$_})."]\n");
		}
	    }
	}
    }

    # LAST Warning. If some data has been detected on the local drive, and
    # if the chosen image is definitely going to overwrite it, ask for a
    # last confirmation. Except if AUTO is on.
    #
    LOG("* Maybe a last R-U-Sure screen ?...\n");

    if((defined($P{AUTO}) && $P{AUTO}) || YES($P{Dont_Warn_Me}))
    {
	LOG("  AUTO or Dont_Warn_Me param set! No R-U-Sure screen.\n");
    }
    else
    {
	LOG("  Let's see if some local data will be overwritten.\n");

	my(%Parts_Dirs) = ();
	foreach my $D (@Dev_Rich)
	{
	    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	    {
		if($D->{Dirs}->[$i])
		{
		    $Parts_Dirs{$D->{Parts}->[$i]} = $D->{Dirs}->[$i];
		}
	    }
	}
	my $N = keys(%Parts_Dirs);

	my $Warning = "This is the LAST WARNING\n"
	    ."------------------------\n\n";

	if($N > 0)
	{
	    $Warning .= "On the LOCAL hard disk drive of this computer, we have"
		." found some data. Here are a list of partitions which filesystems"
		." we have been able to read, and the directories we have found"
		." in them.\n\n";

	    foreach(keys(%Parts_Dirs))
	    {
		if($_ eq 'null')
		{
		    -- $N;
		}
		else
		{
		    $Warning .= "- Partition [".ADT($_, \@Dev_Rich)
			."] => Directories: [".$Parts_Dirs{$_}."]\n\n";
		}
	    }
	}

	$Warning .= "On the REMOTE side, the image you've asked to restore"
	    ." contains the following files. Please, make sure you understand"
	    ." what their restoration by PING will do before going on. Read"
	    ." the Howto or visit the PING Forum if you need more information.\n\n";

	my $flag = 0;
	foreach my $FF (@FF)
	{
	    my @fields = split(/\//, $FF);
	    my $F = $fields[-1];
	    #
	    # Section added for cciss compatibility (HP SmartArray), + rd + ida.
	    #
	    foreach('cciss', 'rd', 'ida', 'mapper')
	    {
		if($fields[$#fields - 1] =~/^$_$/)
		{
		    $F = $_."/".$F;
		}
	    }

	    if($F =~/[hs]d[abcdef]$/
	       || $F =~/(cciss|ida|rd|mapper)\/c\d{1}d\d{1,2}$/
	       || $F =~/mapper\/VolGroup\d{2}\-LogVol\d{2}$/
	       || $F =~/md\d+$/
	       || $F =~/askme_[abcdef]$/i)
	    {
		$Warning .= "- [".$F."] => will overwrite the master boot record and"
		    ." partition table of device [/dev/".ADT($F, \@Dev_Rich)."]\n\n";
		++ $flag;
	    }
	    elsif($F =~/^bios$/i)
	    {
		$Warning .= "- [".$F."] => Will overwrite your BIOS settings, unless"
		    ." explicitely declined. Be aware that if you apply the BIOS"
		    ." settings of one specific hardware model to another one,"
		    ." you might be forced to restore factory settings to fix"
		    ." your box.\n\n";
		++ $flag;
	    }
	    elsif($F =~/\.first_sectors$/ || $F =~/\.fir$/)
	    {
		my $Dev = $F;
		$Dev =~s/\.fir.*$//i;
		$Warning .= "- [".$F."] => Will overwrite the 20 first sectors of"
		    ." partition [/dev/".ADT($Dev, \@Dev_Rich)."]. If mistakenly"
		    ." applied to a partition, data might become inaccessible"
		    ." (note: if this happens accidentally, use testdisk).\n\n";
		++ $flag;
	    }
	    elsif($F =~/_0\.spl\.zp$/ || $F =~/\.000$/)
	    {
		my $Dev = $F;
		$Dev =~s/_0\.spl\.zp$//;
		$Dev =~s/\.000$//;
		$Warning .= "- [".$F."] => Will overwrite the contents of partition"
		    ." [/dev/".ADT($Dev, \@Dev_Rich)."]. If mistakenly applied"
		    ." to a partition, data will be lost.\n\n";
		++ $flag;
	    }
	}

	$Warning .= "Please, type YES and [Enter] to go on with the restoration"
	    ." process. If you are not sure about the result, or feel you need"
	    ." a backup, just hit Ctrl-Alt-Del to reboot your computer or type"
	    ." NO and [Enter] to exit PING.\n";

	if($N > 0 && $flag)
	{
	    LOG("  Issuing this warning: [".$Warning."]\n");

	    open(W, ">".$TMPDIR."/warning");
	    print W wrap('', '', $Warning);
	    close(W);

	    system("reset; clear; more ".$TMPDIR."/warning");
	    unlink($TMPDIR."/warning");
	    print "\n>> ";

	    my $Grab = '';
	    my $cnt = 0;
	    while($Grab !~/yes/i)
	    {
		if($cnt)
		{
		    print "\nPlease, type YES or NO.\n\n>> ";
		}

		$Grab = <STDIN>;

		if($Grab =~/no/i)
		{
		    Quit();
		}

		++ $cnt;
	    }
	}
	else
	{
	    LOG("  No warning to issue.\n");
	}
    }

    # Then, apply boot sectors and bios settings
    #
    foreach my $FF (@FF)
    {
	my @fields = split(/\//, $FF);
	my $F = $fields[-1];
	#
	# Section added for cciss compatibility (HP SmartArray), + rd + ida.
	#
	foreach('cciss', 'rd', 'ida', 'mapper')
	{
	    if($fields[$#fields - 1] =~/^$_$/)
	    {
		$F = $_."/".$F;
	    }
	}
	#
	# Search for both standard linux devices and cciss/rd/ida/mapper
	# devices to restore
	#
	if($F =~/[hs]d[abcdef]$/
	   || $F =~/(cciss|ida|rd|mapper)\/c\d{1}d\d{1,2}$/
	   || $F =~/mapper\/VolGroup\d{2}\-LogVol\d{2}$/
	   || $F =~/md\d+$/
	   || $F =~/askme_[abcdef]$/i)
	{
	    LOG("  * Restore [/dev/".ADT($F, \@Dev_Rich)."]\n");

	    # Well, unless PING is about to overwrite the source it is to
	    # get the images from !
	    #
	    if($SRC =~/dos/
	       && ((Is_Mounted("/mnt/dos")
		    && HDD_Name(Dev_Mount_Point("/mnt/dos")) eq ADT($F, \@Dev_Rich))
		   || ($Part_For_Storage
		       && HDD_Name($Part_For_Storage) eq ADT($F, \@Dev_Rich))))
	    {
		LOG("    Won't overwrite the bootsector of HDD ["
		    .ADT($F, \@Dev_Rich)."]\n");
		LOG("      because it contains the image to restore!\n");
		sleep($README_SLEEP);
	    }
	    else
	    {
		my $cmd = "dd if=".$FF." of=/dev/".ADT($F, \@Dev_Rich)." 2>&1";
		LOG("    Cmd: [".$cmd."]\n");
		my $out = `$cmd`;
		LOG("    Out: [".$out."]\n");
		LOG("    Synchronizing [/dev/".ADT($F, \@Dev_Rich)."]\n");
		Synchronize_Device(ADT($F, \@Dev_Rich));
		++ $Have_Restored;
	    }
	}
	elsif($F =~/^bios$/i)
	{
	    LOG("  * Found [bios] file\n");
	    if(YES($P{Replace_BIOS}))
	    {
		my $cmd = "echo 2|cmospwd -r \"$FF\" >/dev/null 2>&1";
		LOG("    Cmd: [".$cmd."]\n");
		system($cmd);
	    }
	    else
	    {
		LOG("    BIOS settings must not be replaced. No action.\n");
	    }
	}
    }

    # Now, partitioning instructions, if any
    #
    foreach my $FF (@FF)
    {
	my @fields = split(/\//, $FF);
	my $F = $fields[-1];
	foreach('cciss', 'rd', 'ida', 'mapper')
	{
	    if($fields[$#fields - 1] =~/^$_$/)
	    {
		$F = $_."/".$F;
	    }
	}
	#
	# Search for both standard linux devices and cciss/rd/ida devices to restore
	#
	if($F =~/[hs]d[abcdef]\.part$/i
	   || $F =~/(cciss|rd|ida|mapper)\/c\d{1}d\d{1,2}\.part$/i
	   || $F =~/md\d+\.part$/i
	   || $F =~/mapper\/VolGroup\d{2}\-LogVol\d{2}\.part$/i)
	{
	    LOG("  * Found [".$F."] => partitioning instructions.\n");
	    LOG("    Sorry! these old .part files are not used any more.\n");
	    LOG("    Use a HDD_Target.txt file instead. Please, refer to\n");
	    LOG("    the Howto for more details.\n\n");
	    LOG("    !!! Aborting.\n");
	    sleep($FAILED_SLEEP);
	    Quit();
	}
	elsif($F =~/^HDD_Target\.txt$/i)
	{
	    LOG("  * Found [".$F."] => partitioning instructions.\n");

	    my(@Target_Dev_Rich) = ();
	    HDD_Get_From_Exact_Look($FF, \@Target_Dev_Rich);

	    LOG("\n");
	    LOG("    Info from the HDD_Target.txt file: (Target_Dev_Rich)\n");
	    HDD_Describe(\@Target_Dev_Rich);

	    HDD_Discover(\@Dev, \@Dev_Rich, \@RAID_Members);

	    # Sanity check. We'd better abort now if it appears that instructions
	    # ask us to go over the size of a device.
	    #
	    LOG("    Sanity check: make sure the HDD_Target.txt file does not expect\n");
	    LOG("      a device to be bigger than what we find (u know... size matters ;)\n");

	    for(my $i = 0; $i <= $#Target_Dev_Rich; $i++)
	    {
		LOG("      Checking for device [".$Target_Dev_Rich[$i]->{Dev}."]\n");
		my $target = $Target_Dev_Rich[$i]->{BIOS_Dev_Size};
		my $source = 0;
		if(defined($Dev_Rich[$i]->{BIOS_Dev_Size}))
		{
		    $source = $Dev_Rich[$i]->{BIOS_Dev_Size};
		}
		LOG("        Device size on the system: [".$source."]\n");
		LOG("        Expected size on the HDD_Target.txt file: [".$target."]\n");
		if($target > $source)
		{
		    LOG("\n");
		    LOG("!!! We've got a problem: in your HDD_Target.txt file, you expect\n");
		    LOG("    the ".$Target_Dev_Rich[$i]->{Dev}." device to be at least\n");
		    LOG("    ".$target." bytes big. Alas, we only found ".$source." bytes.\n");
		    LOG("    It's certainly better to abort now.\n");
		    LOG("\n");
		    LOG("Advice: edit your HDD_Targets.txt file, and set sizes as small as\n");
		    LOG("        possible. And let PING extend filesystems and partitions as much\n");
		    LOG("        as possible after the restoration (you might prepare a ping.conf\n");
		    LOG("        file, having Extend_Parts_Whenever_Possible=Y so to automatize this).\n");
		    LOG("\n");
		    sleep($FAILED_SLEEP);
		    Quit();
		}
	    }

	    LOG("    We passed the sanity check! Good.\n");

	    foreach my $D (@Dev)
	    {
		# Delete present parts...
		#
		Delete_All_Parts($D, \@Dev_Rich);

		# Create the parts we've been asked to.
		#
		Recreate_All_Parts($D, \@Target_Dev_Rich);
	    }

	    HDD_Discover(\@Dev, \@Dev_Rich, \@RAID_Members);
	    LOG("    New HDD Description (Dev_Rich)\n");
	    HDD_Describe(\@Dev_Rich);
	}
    }

    # We have just applied a new boot sector in the restoration
    # process, or recreated partitions according to instructions.
    #
    my(@Restored_Dev_Rich) = ();
    HDD_Discover(\@Dev, \@Restored_Dev_Rich, \@RAID_Members);

    LOG("    * Results of device discovery (Restored_Dev_Rich)\n");
    HDD_Describe(\@Restored_Dev_Rich);

    # Sanity Check for Parts
    #
    # 1. What if sdb1 is bigger than sdb ?! yes, it can happen after dd.
    #    We should fix it. And check, later, if a restoration is possible
    #    (fsarchiver and tar might still work is the FS is not too big).
    #
    LOG("  * Sanity Check for Parts\n");

    for(my $i = 0; $i <= $#Restored_Dev_Rich; $i++)
    {
	LOG("    Device [".$Restored_Dev_Rich[$i]->{Dev}."]\n");
	LOG("      Real size: [".$Restored_Dev_Rich[$i]->{BIOS_Dev_Size}."]\n");
	my $PSize = 0;
	for(my $j = 0; $j <= $#{ $Restored_Dev_Rich[$i]->{Parts} }; $j++)
	{
	    LOG("        Part [".$Restored_Dev_Rich[$i]->{Parts}->[$j]."]\n");
	    LOG("        Size: [".$Restored_Dev_Rich[$i]->{Size}->[$j]."]\n");
	    if($Restored_Dev_Rich[$i]->{Size}->[$j] =~/^\d+$/)
	    {
		$PSize += $Restored_Dev_Rich[$i]->{Size}->[$j];
	    }
	}
	LOG("      Total size of parts: [".$PSize."]\n");

	if($PSize <= $Restored_Dev_Rich[$i]->{BIOS_Dev_Size})
	{
	    LOG("      Passed!\n");
	}
	else
	{
	    LOG("\n");
	    LOG("      You're trying to restore to a smaller hdd than the one used for bkp\n");
	    LOG("      It's better to abort now.\n");
	    LOG("\n");
	    LOG("      Please refer to the Howto or to the Forum. There are several ways\n");
	    LOG("      to fix this issue; you'll be able to choose the best suited to your needs.\n");
	    LOG("\n");
	    sleep($FAILED_SLEEP);
	    Quit();
	}
    }
    LOG("    All passed!\n");

    # We have just applied a new boot sector in the restoration
    # process, or recreated partitions according to instructions.
    # We've got the possibility to detect NOW that there will or
    # will not be segments of unused space in the partition table.
    # Detecting it now brings 2 advantages:
    # - raise a possible question before long operations start
    # - let the script maximize the filesystems as usually, after
    #   the contents have been restored.
    #
    LOG("  * Inspecting the new restored partition table, so\n");
    LOG("    to see if empty segments can be used.\n");

    LOG("    * Has the user passed a param telling what to do ?\n");
    if(defined($P{Extend_Parts_Whenever_Possible}))
    {
	LOG("      Extend_Parts_Whenever_Possible:"
	    ." [".$P{Extend_Parts_Whenever_Possible}."]\n");
    }
    else
    {
	LOG("      No.\n");
    }

    if(! defined($P{Extend_Parts_Whenever_Possible})
       || YES($P{Extend_Parts_Whenever_Possible}))
    {
	LOG("    * Let's see if there's at least one segment to extend\n");

	# Here, we'll prepare to extend only partitions, not filesystems.
	# We can *only* extend to the right direction (->).
	#
	# Whatever the partition, if it's followed by a null segment...:
	# - if the partition is an ext'd or a primary, just extend
	# - if it's a logical, then extend no further than the end of
	#   the ext'd part containing the partition followed by a null seg'.
	#
	my $Could_Extend = 0;

	# TODO: the device can be bigger than the sum of parts.
	#   Then, last part could be extended if possible. Or not wanted?

	foreach my $D (@Restored_Dev_Rich)
	{
	    LOG("      Device: [".$D->{Dev}."]\n");

	    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	    {
		LOG("        Partition [".$i."]\n");
		LOG("          Name: [".$D->{Parts}->[$i]."]\n");
		LOG("          Start: [".$D->{Start}->[$i]."]\n");
		LOG("          End: [".$D->{End}->[$i]."]\n");

		my $Loop = 1;

		while($Loop)
		{
		    $Loop = 0;

		    for(my $j = 0; $j <= $#{ $D->{Parts} }; $j++)
		    {
			if($D->{Start}->[$j] == ($D->{End}->[$i] + 1)
			   && $D->{Parts}->[$j] eq 'null')
			{
			    LOG("          Null segment [".$D->{Parts}->[$j]."] after\n");
			    LOG("            Start: [".$D->{Start}->[$j]."]\n");
			    LOG("            End: [".$D->{End}->[$j]."]\n");
			    LOG("            Sectors: [".$D->{Sectors}->[$j]."]\n");
			    LOG("            Size: [".$D->{Size}->[$j]."]\n");

			    my $Not_Logical = 0;

			    if(Is_Part_Extended(Part_Type($D->{Parts}->[$i])))
			    {
				LOG("           This part was an ext'd one; extend more\n");
				++ $Not_Logical;

				# Extend the ext'd; the last part contained in the ext'd
				# will need being extended too.
				#
				$D->{End}->[$i] = $D->{End}->[$j];
				LOG("             New End for part [".$i."]: ["
				    .$D->{End}->[$i]."]\n");

				$D->{Sectors}->[$i] = $D->{End}->[$i] - $D->{Start}->[$i];
				LOG("             New Sectors for part [".$i."]: ["
				    .$D->{Sectors}->[$i]."]\n");

				$D->{Size}->[$i] = $D->{Sectors}->[$i] * $D->{BIOS_Sector_Size};
				LOG("             New Size for part [".$i."]: ["
				    .$D->{Size}->[$i]."]\n");
			    }

			    my $d = Is_Part_Logical($i, $D);

			    if($d == -1)
			    {
				LOG("           This part was primary; extend more\n");
				++ $Not_Logical;

				# Extend the primary
				#
				$D->{End}->[$i] = $D->{End}->[$j];
				LOG("            New End for part [".$i."]: ["
				    .$D->{End}->[$i]."]\n");

				$D->{Sectors}->[$i] = $D->{End}->[$i] - $D->{Start}->[$i];
				LOG("             New Sectors for part [".$i."]: ["
				    .$D->{Sectors}->[$i]."]\n");

				$D->{Size}->[$i] = $D->{Sectors}->[$i] * $D->{BIOS_Sector_Size};
				LOG("             New Size for part [".$i."]: ["
				    .$D->{Size}->[$i]."]\n");
			    }

			    if(! $Not_Logical)
			    {
				LOG("         This part was logical, contained in [".$d."]\n");

				# Extend the logical (same thing as extending a primary,
				# because HDD_Discover() will enumerate two null
				# segments if they are contiguous while first one
				# is contained in an ext'd and the second one is not.
				#
				$D->{End}->[$i] = $D->{End}->[$j];
				LOG("            New End for part [".$i."]: ["
				    .$D->{End}->[$i]."]\n");

				$D->{Sectors}->[$i] = $D->{End}->[$i] - $D->{Start}->[$i];
				LOG("             New Sectors for part [".$i."]: ["
				    .$D->{Sectors}->[$i]."]\n");

				$D->{Size}->[$i] = $D->{Sectors}->[$i] * $D->{BIOS_Sector_Size};
				LOG("             New Size for part [".$i."]: ["
				    .$D->{Size}->[$i]."]\n");
			    }

			    # Suppress the null segment
			    #
			    $D->{Start}->[$j] = 'null';
			    $D->{End}->[$j] = 'null';
			    $D->{Sectors}->[$j] = 'null';
			    $D->{Size}->[$j] = 'null';

			    ++ $Loop;
			    ++ $Could_Extend;
			}
		    }
		}
	    }
	}

	if($Could_Extend)
	{
	    if(! defined($P{Extend_Parts_Whenever_Possible}))
	    {
		LOG("    * At least one segment to extend. Ask the user.\n");

		my $cmd = 'dialog --colors --menu "\Zb\ZnWe have detected that'
		    .' there will be extra space on your drive after restoring'
		    .' the image. We can extend partitions for you, so this'
		    .' space will be available on your system. Do you want'
		    .' us to do so ?\n\n" 13 50 2 '
		    .' "Yes" "" "No" "" 2>'.$TMPDIR.'/checklist.tmp';
		system($cmd);

		if(-z $TMPDIR."/checklist.tmp")
		{
		    Quit();
		}

		open(DB, $TMPDIR."/checklist.tmp");
		while(<DB>)
		{
		    if(m/Y/i)
		    {
			$P{Extend_Parts_Whenever_Possible} = 1;
			last;
		    }
		}
		close(DB);
		unlink($TMPDIR."/checklist.tmp");

		LOG("      =>[".($P{Extend_Parts_Whenever_Possible} ? "Yes!":"No")."]\n");
	    }

	    if(YES($P{Extend_Parts_Whenever_Possible}))
	    {
		LOG("    * Let's extend.\n");

		foreach my $D (@Restored_Dev_Rich)
		{
		    Delete_All_Parts($D->{Dev}, \@Restored_Dev_Rich);
		    Recreate_All_Parts($D->{Dev}, \@Restored_Dev_Rich);
		    LOG("    New HDD Description (Restored_Dev_Rich)\n");
		    HDD_Describe(\@Restored_Dev_Rich);
		}

		# Re-discover, as we might have extended.
		#
		LOG("      Re-discover, as we might have extended.\n");
		HDD_Discover(\@Dev, \@Dev_Rich, \@RAID_Members);
	    }
	}
	else
	{
	    LOG("    * No segment to extend. Go on.\n");
	}
    }

    # When playing with segments, we umount many things...
    #
    if($Part_For_Storage)
    {
	LOG("  * Remount [/dev/".$Part_For_Storage."] on [".$SRC."]\n");
	Mount("/dev/".$Part_For_Storage, "/mnt/dos", "");
    }

    # Now, scans the image directory for any other action
    #
    {
	my $Go_On = 1;             # Rescan the dir after each cd span
                                   # When no more work is done, break.
	my(@Applied) = ();         # Tracks all applied files. To break.

	while($Go_On)
	{
	    $Go_On = 0;
	    if($SRC =~/cdrom/i)
	    {
		Umount("/dev/".$CD_Dev);
		Exec_Log("mount /dev/".$CD_Dev." /mnt/cdrom", 4);
	    }
	    Read_Dir(\@F, \@FF, \$Multi);       # Will feed @F, @FF and $Multi

	    LOG("    F:\n");
	    foreach(@F)
	    {
		LOG("    - [".$_."]\n");
	    }
	    LOG("    FF:\n");
	    foreach(@FF)
	    {
		LOG("    - [".$_."]\n");
	    }

	    foreach my $FF (@FF)
	    {
		my @fields = split(/\//, $FF);
		my $F = $fields[-1];
		foreach('cciss', 'rd', 'ida', 'mapper')
		{
		    if($fields[$#fields - 1] =~/^$_$/)
		    {
			$F = $_."/".$F;
		    }
		}

		unless($F =~/\.000$/ || $F =~/\.zip$/i || $F =~/\.first_sectors$/
		       || $F =~/\.fir$/ || $F =~/_0\.spl\.zp$/ || $F =~/MULTI$/i
		       || Is_Archive($F) || $F =~/Help_Dell$/i
		       || $F =~/\.RecFiles\.txt$/i
		       || $F =~/\.img(\.gz)?(\.bz2)?\.xaa$/
		       || $F =~/\.fsa$/)
		{
		    next;
		}

		LOG("  * Restore [/dev/... from ".$F."] with [".$FF."]\n");

		my $Already_Applied = 0;
		foreach my $A (@Applied)
		{
		    if($A eq $FF)
		    {
			++ $Already_Applied;
			last;
		    }
		}
		if($Already_Applied)
		{
		    LOG("    Already applied. Next, if any.\n");
		    next;
		}

		if($FF =~/\.first_sectors$/ || $FF =~/\.fir$/)
		{
		    my $Dev = $F;
		    $Dev =~s/\.first_sectors$//;
		    $Dev =~s/\.fir$//;

		    # Well, unless PING is about to overwrite the source it is to
		    # get the images from !
		    #
#		    if($SRC =~/dos/
#		       && ((Is_Mounted("/mnt/dos")
#			    && HDD_Name(Dev_Mount_Point("/mnt/dos"))
#			    eq ADT($Dev, \@Dev_Rich))
#			   || ($Part_For_Storage
#			       && HDD_Name($Part_For_Storage) eq ADT($Dev,\@Dev_Rich))))
#		    {
#			LOG("    Won't overwrite the first sectors of ["
#			    .ADT($Dev, \@Dev_Rich)."]\n");
#			LOG("      because it contains the image to restore!\n");
#			sleep($README_SLEEP);
#		    }
#		    else
#		    {
#			Exec_Log("dd if=\"$FF\" of=/dev/".ADT($Dev, \@Dev_Rich), 4);
#			LOG("    Synchronizing [/dev/".ADT($Dev, \@Dev_Rich)."]\n");
#			Synchronize_Device(ADT($Dev, \@Dev_Rich));

			# Give LVM a chance to succeed
			# Note: when it comes to LVM, it's crucial that
			#   .first_sectors/.fir files should be restored before
			#   the parts themselves, for the vgchange command
			#   to succeed. This is the case, thanks to the
			#   Read_Dir() function.
			#
#			Exec_Log("vgscan; vgchange -ay; dmraid -ay", 4);
#		    }

		    push(@Applied, $FF);
		    $Go_On = 1;
		}

		# When zsplitted, filename is hda5_0.spl.zp (and _1.spl.zp etc.)
		#
		# We can send the multivol argument to partimage even if all
		# files are accessible, as partimage can detect that it has
		# finished its job. Well, unzsplit cannot. So, the rule will
		# be arbitrary and utterly unfair :) if we've got to
		# unzsplit hda1* files and there's an empty MULTI file in
		# the directory and there's at least one hdaX* file with
		# X > 1 (the 1 of hda1), then no multivol argument.

		if($FF =~/_0\.spl\.zp$/)
		{
		    my $Dev = $F;
		    $Dev =~s/_0\.spl\.zp$//;

		    my $Multi_Concerned = 0;

		    # Well, unless PING is about to overwrite the source it is to
		    # get the images from !
		    #
		    if($SRC =~/dos/
		       && ((Is_Mounted("/mnt/dos")
			    && HDD_Name(Dev_Mount_Point("/mnt/dos"))
			    eq ADT($F, \@Dev_Rich))
			   || ($Part_For_Storage
			       && HDD_Name($Part_For_Storage) eq ADT($F, \@Dev_Rich))))
		    {
			LOG("    Won't overwrite the partition ["
			    .ADT($Dev, \@Dev_Rich)."]\n");
			LOG("      because it contains the image to restore!\n");
			sleep($README_SLEEP);
		    }
		    else
		    {
			Umount("/dev/".ADT($Dev, \@Dev_Rich));
			#
			# unzsplit dislikes SMB mounts, but stops complaining
			# if given a symlink... (or cat | unzsplit -c). Well...
			# Better create now a huge number of symlinks, as there
			# may be a multivol, and we won't know how many are needed.
			# BTW, unzsplit does not tolerate paths like $TMPDIR///toto.
			#
			# Now, unzsplit is happy again.
			#
			my $Base = $F;
			$Base =~s/\_0.spl.zp$//;
			Exec_Log("rm -f ".$TMPDIR."/".$Base.".*.spl.zp", 4);
			my $A = $SRC."/".$Entity."/".$Base."_*.spl.zp";
			$A =~s/\/+/\//g;
			Exec_Log("cd ".$TMPDIR."; ln -sf ".$A." .", 4);

			LOG("    Is [".ADT($Dev, \@Dev_Rich)
			    ."] concerned by the general MULTI flag ?\n");
			$Multi_Concerned = 1;
			{
			    my $Number = $F;
			    $Number =~s/^(\D)*//;
			    $Number =~s/(\D).*$//;
			    LOG("      Current part's number: [".$Number."]\n");
			    opendir(DIR, $SRC."/".$Entity);
			    my(@Files) = readdir(DIR);
			    closedir(DIR);
			    my $Found = 0;
			    foreach my $File (@Files)
			    {
				next if($File =~/^\.{1,2}$/);
				if($File eq $F)
				{
				    ++ $Found;
				    next;
				}
				if($Found)
				{
				    my $Number2 = $File;
				    $Number2 =~s/^(\D)*//;
				    $Number2 =~s/(\D).*$//;
				    next if($Number2 !~/^\d+$/);
				    LOG("      Number of [".$File."]: [".$Number2."]\n");
				    if($Number2 > $Number)
				    {
					$Multi_Concerned = 0;
					last;
				    }
				}
			    }
			}
			LOG("      ".($Multi_Concerned ? "Yes":"No")."!\n");
		
			if($Multi && $Multi_Concerned)
			{
			    # Don't call Umount() here, obviously enough :)
			    #
			    my $Todo = "umount /mnt/cdrom >/dev/null 2>&1;"
				." eject /dev/cdrom >/dev/null 2>&1;"
				." sleep 20;"
				." mount /dev/cdrom /mnt/cdrom >/dev/null 2>&1;"
				." cd ".$TMPDIR."; ln -sf ".$A." .";
			    my $cmd = "/etc/rc.d/rc.multi unzsplit \"$Todo\" &";
			    LOG("    * Multivol! Cmd: [".$cmd."]\n");
			    system($cmd);
			    $Go_On = 1;
			}
			#
			# -d brings the debug log into a file. If multivol,
			# you'll prefer see it on the screen.
			#
			Exec_Log("cd ".$TMPDIR."; unzsplit "
				 .($Multi && $Multi_Concerned ? "-m":"")
				 ." -d -D /dev/".ADT($Dev, \@Dev_Rich)." ".$Dev, 4);
		    }

		    push(@Applied, $FF);
		    $Go_On = 1;
		    if(-e $TMPDIR."/debug.log")
		    {
			my $out = "";
			open(DB, $TMPDIR."/debug.log");
			while(<DB>)
			{
			    $out .= $_;
			}
			close(DB);
			unlink($TMPDIR."/debug.log");
			LOG("      Output: [".$out."]\n");
		    }
		    Exec_Log("rm -f ".$TMPDIR."/*.spl.zp", 4);

		    # Re-read the source directory (must have changed)
		    #
		    if($Multi && $Multi_Concerned)
		    {
			Read_Dir(\@F, \@FF, \$Multi);  # Will feed @F, @FF & $Multi
		    }
		}
		elsif($FF =~/\.fsa$/)
		{
		    # This is a FSArchiver image.

		    my $Dev = $F;
		    $Dev =~s/\.fsa$//;

		    # Well, unless PING is about to overwrite the source it is to
		    # get the images from !
		    #
		    if($SRC =~/dos/
		       && ((Is_Mounted("/mnt/dos")
			    && HDD_Name(Dev_Mount_Point("/mnt/dos"))
			    eq ADT($Dev, \@Dev_Rich))
			   || ($Part_For_Storage
			       && HDD_Name($Part_For_Storage) eq ADT($Dev,\@Dev_Rich))))
		    {
			LOG("    Won't overwrite the partition ["
			    .ADT($Dev, \@Dev_Rich)."]\n");
			LOG("      because it contains the image to restore!\n");
			sleep($README_SLEEP);
		    }
		    else
		    {
			Umount("/dev/".ADT($Dev, \@Dev_Rich));

			# fsarchiver cannot write into a non-formated device.
			#
			if(Is_Mountable(ADT($Dev, \@Dev_Rich)))
			{
			    LOG("    [".$Dev."] is mountable. FSArchiver should be happy\n");
			}
			else
			{
			    LOG("    [".$Dev."] is not mountable, we must format the filesystem\n");
			    LOG("      Get from the HDD_Look.txt file the dest filesystem type\n");

			    my $ToType = "";
			    foreach my $D (@Image_Dev_Rich)
			    {
				for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
				{
				    if($D->{Parts}->[$i] eq $Dev)
				    {
					$ToType = $D->{FS_Types}->[$i];
				    }
				}
			    }

			    LOG("      ToType (1): [".$ToType."]\n");

			    unless($ToType)
			    {
				LOG("      Let's try to query the fsa file\n");

				my $cmd = "fsarchiver archinfo \"".$FF."\" 2>&1";

				$cmd =~s/\/\.\//\//g;    # No x/./y
				$cmd =~s/\/+/\//g;       # No x//y

				LOG("    Cmd: [".$cmd."]\n");
				my $out = `$cmd`;
				LOG("    Out: [".$out."]\n");

				# Filesystem format:              ntfs
				my(@lines) = split(/\n/, $out);
				foreach my $L (@lines)
				{
				    if($L =~/^Filesystem format:\s+([a-zA-Z0-9]+)\s*$/)
				    {
					$ToType = $1;
				    }
				}

				LOG("      ToType (2): [".$ToType."]\n");
			    }

			    if($ToType)
			    {
				Format(ADT($Dev, \@Dev_Rich), $ToType);
			    }
			    else
			    {
				LOG("      No target type could be found! we won't format.\n");
				LOG("      May still work.\n");
			    }
			}

			my $cmd = "fsarchiver -v restfs \"".$FF."\" id=0,dest=/dev/".ADT($Dev, \@Dev_Rich)
			    ." >/var/log/fsarchiver.log 2>&1 &";

			$cmd =~s/\/\.\//\//g;    # No x/./y
			$cmd =~s/\/+/\//g;       # No x//y

			LOG("    Cmd: [".$cmd."]\n");
			my $out = `$cmd`;
			LOG("    Out: [".$out."]\n");

                        system("tail -f /var/log/fsarchiver.log &");

                        my $cnt = 0;
                        while(++ $cnt)
                        {
                            if(Is_PName_Running("fsarchiver"))
                            {
                                sleep(10);
                                next;
                            }
                            else
                            {
                                KILL("tail");
                                last;
                            }
                        }
		    }

		    push(@Applied, $FF);
		    $Go_On = 1;
		}
		elsif($FF =~/\.000$/)
		{
		    # This is a partimage image.

		    my $Dev = $F;
		    $Dev =~s/\.\d{3}$//;

		    # Well, unless PING is about to overwrite the source it is to
		    # get the images from !
		    #
		    if($SRC =~/dos/
		       && ((Is_Mounted("/mnt/dos")
			    && HDD_Name(Dev_Mount_Point("/mnt/dos"))
			    eq ADT($Dev, \@Dev_Rich))
			   || ($Part_For_Storage
			       && HDD_Name($Part_For_Storage) eq ADT($Dev,\@Dev_Rich))))
		    {
			LOG("    Won't overwrite the partition ["
			    .ADT($Dev, \@Dev_Rich)."]\n");
			LOG("      because it contains the image to restore!\n");
			sleep($README_SLEEP);
		    }
		    else
		    {
			Umount("/dev/".ADT($Dev, \@Dev_Rich));
			if($Multi)
			{
			    # Don't use Umount() here, obviously enough :)
			    #
			    my $Todo = "umount /mnt/cdrom >/dev/null 2>&1;"
				." eject /dev/cdrom >/dev/null 2>&1;"
				." sleep 20;"
				." mount /dev/cdrom /mnt/cdrom >/dev/null 2>&1";
			    my $cmd = "/etc/rc.d/rc.multi partimage \"$Todo\" &";
			    LOG("    * Multivol! Cmd: [".$cmd."]\n");
			    system($cmd);
			    $Go_On = 1;
			}
			my $cmd = "sleep ".$PARTIMAGE_SLEEP."; partimage "
			    .($Multi ? "-w":"")
			    ." -f3 -b -c -d -o restore /dev/".ADT($Dev, \@Dev_Rich)
			    ." \"$FF\"; sleep ".$PARTIMAGE_SLEEP."; reset";
			LOG("    Cmd: [".$cmd."]\n");
			system($cmd);
			my $out = `tail --lines=15 /var/log/partimage-debug.log 2>&1`;
			LOG("    Output: (...) [".$out."]\n");
		    }

		    push(@Applied, $FF);
		    $Go_On = 1;
		}
		elsif($FF =~/\.img(\.gz)?(\.bz2)?\.xaa$/)
		{
		    # This is a Partclone image.
		    # Note: no multi with partclone.

		    my $Dev = $F;
		    $Dev =~s/\.img(\.gz)?(\.bz2)?\.xaa$//;

		    # Well, unless PING is about to overwrite the source it is to
		    # get the images from !
		    #
		    if($SRC =~/dos/
		       && ((Is_Mounted("/mnt/dos")
			    && HDD_Name(Dev_Mount_Point("/mnt/dos"))
			    eq ADT($Dev, \@Dev_Rich))
			   || ($Part_For_Storage
			       && HDD_Name($Part_For_Storage) eq ADT($Dev,\@Dev_Rich))))
		    {
			LOG("    Won't overwrite the partition ["
			    .ADT($Dev, \@Dev_Rich)."]\n");
			LOG("      because it contains the image to restore!\n");
			sleep($README_SLEEP);
		    }
		    else
		    {
			Umount("/dev/".ADT($Dev, \@Dev_Rich));
			if($Multi)
			{
			    LOG("    * Multivol!!! Not supported with partclone\n");
			    LOG("      ...unless another workaround can be found\n");
			    sleep($README_SLEEP);
			}

			# Normally, having restored the first sectors,
			# we can get the filesystem from the device.
			# This is alas necessary, as we must clone partclone.XXX
			# where XXX is the filesystem type.
			#
			foreach("partclone.log", "partclone.stderr")
			{
			    if(-e "/var/log/".$_)
			    {
				unlink("/var/log/".$_);
			    }
			}

			# I've got no way to get the FS type from the name of
			# the device. I should not try to have FS_Type() query it,
			# as it would give the present FS, and not the FS that was
			# on the imaged partition. The correct answer is in the
			# HDD_Look.txt file.
			#
			LOG("      Searching for FS Type of [".$Dev."]\n");

			my $PEXT = "";
			my $FS_Type = "";
			foreach my $D (@Image_Dev_Rich)
			{
			    LOG("      - [".$D->{Dev}."]\n");
			    LOG("        HDD_Name: [".HDD_Name($Dev)."]\n");

			    if($D->{Dev} eq HDD_Name($Dev))
			    {
				LOG("        This matches dev of part [".$Dev."]\n");
				LOG("        Nb of parts: [".$#{ $D->{Parts} }."]\n");
				LOG("        Enumerating parts...\n");

				for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
				{
				    LOG("        Part number of [".$Dev."]: ["
					.Part_Number($Dev)."] (1)\n");
				    LOG("        Part number of [".$D->{Parts}->[$i]
					."]: [".Part_Number($D->{Parts}->[$i])
					."] (2)\n");

				    if(Part_Number($Dev)
				       == Part_Number($D->{Parts}->[$i]))
				    {
					$FS_Type = $D->{FS_Types}->[$i];
					LOG("        Found! =>[".$FS_Type."]\n");
					last;
				    }
				}
			    }
			}

			LOG("      FS Type of [".$Dev."]: [".$FS_Type."]\n");

			foreach("ext4", "reiserfs", "reiser4", "btrfs", "xfs",
				"ufs", "vmfs", "ext2", "ext3", "fat32", "ntfs")
			{
			    if($FS_Type =~/^$_$/i)
			    {
				$PEXT = ".".$_;
			    }
			}

			my $CPR = "";
			if($FF =~/\.gz\.xaa$/)
			{
			    $CPR = "gzip";
			}
			elsif($FF =~/\.bz2\.xaa$/)
			{
			    $CPR = "bzip2";
			}

			my $GLOB = $FF;
			$GLOB =~s/\.xaa$/\.x/;

			my $cmd = "cat \"$GLOB\"*";  # Yes, the star is AFTER the quote
			if($CPR)
			{
			    $cmd .= "|".$CPR." -d -c";
			}
			$cmd .= "|partclone".$PEXT." -L /var/log/partclone.log -I"
			    ." -r -d -F -o /dev/".ADT($Dev, \@Dev_Rich)
			    ." 2>/var/log/partclone.stderr";

			LOG("    Cmd: [".$cmd."]\n");
			system($cmd);

			if(-e "/var/log/partclone.stderr")
			{
			    LOG("    Stderr! Contains:\n");
			    my $out = `tail --lines=15 /var/log/partclone.stderr 2>&1`;
			    LOG("      [".$out."]\n");
			}
			if(-e "/var/log/partclone.log")
			{
			    LOG("    Output:\n");
			    my $out = `tail --lines=15 /var/log/partclone.log 2>&1`;
			    LOG("      [".$out."]\n");

			    if($out =~/successfully/i)
			    {
				LOG("      Success!\n");
			    }
			    else
			    {
				LOG("      Failed!\n");
			    }
			}
		    }

		    push(@Applied, $FF);
		    $Go_On = 1;
		}
		elsif(Is_Archive($FF)
		      && ($FF !~/addon(\-|_).*\.tar\.(gz|bz2|xz)/i
			  || $FF !~/addon(\-|_).*\.zip/i))
		{
		    my $Dev = "";
		    {
			my @f1 = split(/\./, $F);
			$Dev = $f1[0];
		    }

		    my $TType = Is_NTFS(Part_Type(ADT($Dev, \@Dev_Rich)))
			? "-t ".$NTFS_MNT_TYPE:"";

		    # If a partition where the user wants data to be
		    # untarred can't be mounted, it should mean that it
		    # is a new partition, with no data. Not an update, but
		    # a 100%-tar-archived image (probably a linux system).
		    #
		    unless(Is_Mountable(ADT($Dev, \@Dev_Rich)))
		    {
			LOG("    Partition [".ADT($Dev, \@Dev_Rich)."] can't be"
			    ." mounted. Format!\n");
			Umount(ADT($Dev, \@Dev_Rich));

		        my $ToType = "";
			foreach my $D (@Image_Dev_Rich)
			{
			    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
			    {
				if($D->{Parts}->[$i] eq $Dev)
				{
				    $ToType = $D->{FS_Types}->[$i];
				}
			    }
			}

			LOG("      ToType (1): [".$ToType."]\n");

                        unless($ToType)
                        {
                            if($FF =~/\.(gz|bz2|xz)$/)
                            {
                                LOG("      Assume ext4 ! (crazy)\n");
                                $ToType = "ext4";
                            }
                            elsif($FF =~/\.zip$/)
                            {
                                LOG("      Assume ntfs ! (crazy)\n");
                                $ToType = "ntfs";
                            }
			    LOG("      ToType (2): [".$ToType."]\n");
                        }

			Format(ADT($Dev, \@Dev_Rich), $ToType);
		    }

		    # The tarball might be empty. Then, save time.
		    unless(-z $FF)
		    {
			Umount("/mnt/win");
			Mount("/dev/".ADT($Dev, \@Dev_Rich), "/mnt/win", "RW");

			if(! Is_Mounted(ADT($Dev, \@Dev_Rich))
			   && Is_NTFS(Part_Type(ADT($Dev, \@Dev_Rich))))
			{
			    LOG("      Not mounted... ntfsfix & 2nd try\n");
			    Exec_Log("ntfsfix /dev/".ADT($Dev, \@Dev_Rich), 6);
			    Mount("/dev/".ADT($Dev, \@Dev_Rich), "/mnt/win", "RW");
			}

			if(Is_Mounted(ADT($Dev, \@Dev_Rich)))
			{
			    Exec_Log("cd /mnt/win; ".Unzip($FF)."; sleep 2", 6);
			}
			else
			{
			    LOG("      ! Can't mount the part, won't unzip [".$FF."]\n");
			    sleep($README_SLEEP);
			}

			Umount("/mnt/win");
			sleep(2);
			push(@Applied, $FF);
			$Go_On = 1;
		    }
		}
                elsif($FF =~/\.RecFiles\.txt$/i)
                {
		    my $Dev = $F;
		    $Dev =~s/\.RecFiles\.txt$//i;

		    LOG("    Will we use [".$FF."] to find out files to delete ?\n");
                    if(! -e $SRC."/".$Entity."/".$FF.".old")
                    {
                        LOG("      Well, a [".$FF.".old] file could not be found...\n");
                        LOG("      => Seems useless.\n");
                    }
                    else
                    {
                        Umount("/mnt/win");
		        Mount("/dev/".$Dev, "/mnt/win", "RW");

		        my $cnt = 0;
                        my $cnt2 = 0;

		        my(%Keep) = ();
		        open(R, $FF);
		        while(<R>)
		        {
                            s/^\s*//;
                            s/\s*$//;
			    my(@fields) = split(/\;/, $_);
			    $Keep{$fields[0]} = 1;
		        }
		        close(R);

    		        sub rec_Delete
		        {
			    my($dir) = shift || '';
			    return() unless($dir && -e $dir);

			    opendir(DIR, $dir);
			    my(@files) = readdir(DIR);
			    closedir(DIR);

			    foreach my $file (@files)
			    {
			        next if($file =~/^\.{1,2}$/);

				++ $cnt;
				if(($cnt / 1000) == int($cnt / 1000))
				{
				    LOG("      [".$cnt."] files checked for removal\n");
				}

				my $path = $dir."/".$file;
				$path =~s/^\/mnt\/win//;

				if(-d $dir."/".$file)
				{
				    if(! defined($Keep{$path}) && -e $dir."/".$file)
				    {
					system("rm -fr \"".$dir."/".$file."\"");
					++ $cnt2;
				    }
				    rec_Delete($dir."/".$file);
				}
				else
				{
				    if(! defined($Keep{$path}) && -e $dir."/".$file)
				    {
					unlink($dir."/".$file);
					++ $cnt2;
				    }
				}
			    }
			}

                        rec_Delete("/mnt/win");
                        Umount("/mnt/win");

                        LOG("      [".$cnt2."] files/dirs have been removed\n");
                    }

		    push(@Applied, $FF);
		    $Go_On = 1;
                }
		elsif($FF =~/MULTI$/i)
		{
		    LOG("    It's a multi. New image files (at least one .000)\n");
		    LOG("      to be found on a new CD/DVD. Spanning now...\n");
		    KILL("rc.multi");
		    Umount("/mnt/cdrom");
		    sleep(1);
		    Exec_Log("eject /dev/cdrom", 4);
		    print "\nINSERT the next CD/DVD\n";
		    <STDIN>;
		    Exec_Log("mount /dev/cdrom /mnt/cdrom", 4);
		    $Go_On = 1;
		}
		elsif($FF =~/help_dell$/i)
		{
		    LOG("  * Found [Help_Dell] file. We must fix the boot sector.\n");
                    Write_Std_MBR($Dev_Rich[0]->{Dev});
	            for(my $i = 0; $i <= $#{ $Dev_Rich[0]->{Parts} }; $i++)
	            {
                        if($Dev_Rich[0]->{Boot_Flags}
                            && $Dev_Rich[0]->{Parts}->[$i] ne "null")
                        {
                            Fix_Dell_Boot($Dev_Rich[0]->{Parts}->[$i]);
                            last;
                        }
                    }
		    push(@Applied, $FF);
		    $Go_On = 1;
		}
	    }
	}
    }
}


# Unmount the stuff.
#
LOG("* Unmounting [".$SRC."]\n");
Umount($SRC);


# If we had minimized one partition before storing it, it's now
# time to restore the partition table as it was before.
# That way, we'll be able to call ntfsresize so to remaximize.
#
if($Have_Minimized_Before_Storing)
{
    LOG("* There has been a partition minimization...\n");

    foreach(@Minimized_Devices)
    {
	Delete_All_Parts($_, \@Dev_Rich);
	Recreate_All_Parts($_, \@Dev_Rich);
    }
}


# One last sync, just in case
#
if($Have_Restored)
{
    LOG("* One last sync, just in case\n");
    foreach(@Dev)
    {
	Synchronize_Device($_);
    }
}


# Sometimes, users might create images with a small hdd-equipped station,
# and restore it on stations with bigger hdds. They might use a HDD_Target.txt
# file to specify bigger parts. As a result, we can end up with 10-GB
# filesystems in a 40-GB partition... We can handle this easily. Yet,
# we'll help only as far as NTFS filesystems are involved.
#
# Note: after testing, not so sure NTFS needs it... doing it anyway.
#
if($Have_Restored || $Have_Minimized_Before_Storing)
{
    LOG("* There has been a restoration or a Minimization...\n");
    LOG("  Let's make sure no partition is bigger than the\n");
    LOG("  filesystem it contains (not all FS supported)\n");

    foreach my $D (@Dev_Rich)
    {
	LOG("  Device: [".$D->{Dev}."]\n");

	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    if($D->{Parts}->[$i] eq 'null')
	    {
		next;
	    }
	    LOG("    Partition [".$i."]\n");
	    LOG("      Name: [".$D->{Parts}->[$i]."]\n");

	    my $Part_Size = ($D->{End}->[$i] - $D->{Start}->[$i])
		* $D->{BIOS_Sector_Size};
	    LOG("      Part Size: [".$Part_Size."] bytes\n");

	    my $FS_Size = FS_Size($D->{Parts}->[$i]);
	    LOG("      Filesystem Size: [".$FS_Size."] bytes\n");

	    if($FS_Size < $Part_Size - 1000000)
	    {
		LOG("      It's interesting to augment the volume size\n");

		my $Max_Size = FS_Maximum_Size($D->{Parts}->[$i],
					       $D->{Dev},
					       $D->{BIOS_Sector_Size});
		LOG("      Let's resize to [".$Max_Size."] bytes\n");

		my $Max_Size_Sectors = int($Max_Size / $D->{BIOS_Sector_Size});
		LOG("      - well, to [".$Max_Size_Sectors."] sectors\n");

		if($Max_Size && $FS_Size)
		{
		    if(FS_Resize($D->{Parts}->[$i], $Max_Size_Sectors, $Max_Size))
		    {
			LOG("\n");
			LOG("      ! We could not resize that filesystem.\n");
			LOG("        You will have to do it yourself inside your OS.\n");
			LOG("\n");
			if(Is_NTFS($D->{Parts}->[$i]))				
			{
			    LOG("      Sorry. This happens sometimes. So, what's going to happen ?\n");
			    LOG("      1. You're going to reboot Windows. It will complain about\n");
			    LOG("         the filesystem consistency and chkdsk it. Accept everything.\n");
			    LOG("      2. Your C drive will look almost 100% full. Yet, when trying\n");
			    LOG("         to manage disk storage, you'll see a bigger C drive!\n");
			    LOG("         If Windows utilities help you out, good. If not : \n");
			    LOG("      3. After Windows has chkdsk-ed everything, reboot PING.\n");
			    LOG("      4. Get a shell when proposed to (type 'x' and logon as root.)\n");
			    LOG("      5. Then, issue the following command:\n");
			    LOG("         ntfsresize -s ".$Max_Size." -f ".$D->{Parts}->[$i]."\n");
			    LOG("\n");
			    LOG("      And you're done.\n");
			    LOG("\n");
			    print "Press [ENTER] to proceed\n";
			    <STDIN>;
			}
			sleep($FAILED_SLEEP);
		    }
		    else
		    {
			LOG("      The resizing seems OK. Good.\n");
		    }
		}
		else
		{
		    LOG("\n");
		    LOG("      ! The filesystem could not be evaluated.\n");
		    LOG("        Maybe you will have to do it yourself.\n");
		    LOG("\n");
		    sleep($FAILED_SLEEP);
		}
	    }
	    else
	    {
		LOG("      No interest to augment the volume size.\n");
	    }
	}
    }
}



# The End
#
Quit();



sub LOG
{
    my $Say = shift;
    my $Now = Time();
    unless(defined($P{Verbosity}) && $P{Verbosity} == 0)
    {
	print $$." ".$MYSELF." ".$Now."> ".$Say;
    }
    else
    {
	system("clear");
	if($P{Unique_Message})
	{
	    print $P{Unique_Message};
	}
    }
    open(LOG, ">>".$LOG_PATH);
    print LOG $$." ".$MYSELF." ".$Now."> ".$Say;
    close(LOG);
}


sub YES
{
    my $it = shift;
    $it = "" unless(defined($it));
    return(($it =~/1|Y/i) ? 1:0);
}


sub Print_Shell_Help
{
    print "To have several terms, get a shell and launch /opt/PING/rc.ping.\n\n";
    print "The shell has every tool you need to modify or format partitions,\n";
    print "or to access data on a local hard disk. Most filesystems are\n";
    print "currently supported, NTFS included ($NTFS_MNT_TYPE).\n";
    print "\n";
    print "Basic Shell Reminder:\n";
    print "To mount a NTFS volume: $NTFS_MNT /dev/sda1 /mnt/dos\n";
    print "To get an IP address through DHCP: dhcpcd eth0 (or: dhcpcd eth1)\n";
    print "To manually set up your network config (adjust):\n";
    print "  ifconfig eth0 192.168.0.123 netmask 255.255.255.0 up\n";
    print "  route add default gw 192.168.0.1\n";
    print "To mount a SMB (MS network share) partition:\n";
    print "  mount.cifs //192.168.0.1/myshare /mnt/smbfs -o";
    print " username=xxx,password=yyy\n";
    print "To call fdisk on local parts: fdisk /dev/hda (or hdb, hdc, sda, sdb)\n";
}


sub Ask_If_Suppress_RootSys_Files
{
    LOG("Ask_If_Suppress_RootSys_Files> Ask!\n");

    my $cmd = 'dialog --colors --menu "\Zb\ZnWhen backuping Windows OSes,'
	.' by default, PING removes some files. These are the C:\pagefile.sys,'
	.' hiberfile.sys, swapfile.sys. It'."'".'s nice to have backups smaller'
	.' and restorations faster this way, and safe, as Windows will recreate'
	.' these files automatically. The only drawback is that Windows will'
	.' ask the user about the size of the new pagefile.sys to create. So,'
	.' say N if you don'."'".'t want to hear any user complain, nor have'
	.' to deal with a VBS or Powershell script if you plan a mass deployment'
	.' of OSes.\n\n" 19 60 2 '
	.' "Yes" "" "No" "" 2>'.$TMPDIR.'/checklist.tmp';
    system($cmd);

    $P{Suppress_RootSys_Files} = 0;
    open(DB, $TMPDIR."/checklist.tmp");
    while(<DB>)
    {
	if(m/Y/i)
	{
	    $P{Suppress_RootSys_Files} = 1;
	    last;
	}
    }
    close(DB);
    unlink($TMPDIR."/checklist.tmp");

    LOG("Ask_If_Suppress_RootSys_Files> User said [".$P{Suppress_RootSys_Files}."]\n");
}


# Ex.: Is_PName_Running("fsarchiver")
#
sub Is_PName_Running
{
    my $PName = shift;
    $PName = "" unless(defined($PName));
    return unless($PName);
    my $out = `ps axww`;
    my(@lines) = split(/\n/, $out);
    foreach my $L (@lines)
    {
	$L =~s/^\s*\d+\s+\S+\s+\S+\s+\S+\s+//;
	if($L =~/^$PName/)
	{
	    return(1);
	}
    }
    return(0);
}


sub ID_To_Type
{
    my($ID) = shift;
    return unless($ID);

    my %Corr = (
	"0" => "Empty",
	"1e" => "Hidden W95 FAT1",
	"80" => "Old Minix",
	"be" => "Solaris boot",
	"1" => "FAT12",
	"24" => "NEC DOS",
	"81" => "Minix / old Lin",
	"bf" => "Solaris",
	"2" => "XENIX root",
	"39" => "Plan 9",
	"82" => "Linux swap / So",
	"c1" => "DRDOS/sec (FAT-",
	"3" => "XENIX usr",
	"3c" => "PartitionMagic",
	"83" => "Linux",
	"c4" => "DRDOS/sec (FAT-",
	"4" => "FAT16 <32M",
	"40" => "Venix 80286",
	"84" => "OS/2 hidden C:",
	"c6" => "DRDOS/sec (FAT-",
	"5" => "Extended",
	"41" => "PPC PReP Boot",
	"85" => "Linux extended c7 Syrinx",
	"6" => "FAT16",
	"42" => "SFS",
	"86" => "NTFS volume set",
	"da" => "Non-FS data",
	"7" => "HPFS/NTFS",
	"4d" => "QNX4.x",
	"87" => "NTFS volume set",
	"db" => "CP/M / CTOS / .",
	"8" => "AIX",
	"4e" => "QNX4.x 2nd part",
	"88" => "Linux plaintext",
	"de" => "Dell Utility",
	"9" => "AIX bootable",
	"4f" => "QNX4.x 3rd part",
	"8e" => "Linux LVM",
	"df" => "BootIt",
	"a" => "OS/2 Boot Manag",
	"50" => "OnTrack DM",
	"93" => "Amoeba",
	"e1" => "DOS access",
	"b" => "W95 FAT32",
	"51" => "OnTrack DM6 Aux",
	"94" => "Amoeba BBT",
	"e3" => "DOS R/O",
	"c" => "W95 FAT32 (LBA)",
	"52" => "CP/M",
	"9f" => "BSD/OS",
	"e4" => "SpeedStor",
	"e" => "W95 FAT16 (LBA)",
	"53" => "OnTrack DM6 Aux",
	"a0" => "IBM Thinkpad hi",
	"eb" => "BeOS fs",
	"f" => "W95 Ext'd (LBA)",
	"54" => "OnTrackDM6",
	"a5" => "FreeBSD",
	"ee" => "EFI GPT",
	"10" => "OPUS",
	"55" => "EZ-Drive",
	"a6" => "OpenBSD",
	"ef" => "EFI (FAT-12/16/",
	"11" => "Hidden FAT12",
	"56" => "Golden Bow",
	"a7" => "NeXTSTEP",
	"f0" => "Linux/PA-RISC b",
	"12" => "Compaq diagnost",
	"5c" => "Priam Edisk",
	"a8" => "Darwin UFS",
	"f1" => "SpeedStor",
	"14" => "Hidden FAT16 <3",
	"61" => "SpeedStor",
	"a9" => "NetBSD",
	"f4" => "SpeedStor",
	"16" => "Hidden FAT16",
	"63" => "GNU HURD or Sys",
	"ab" => "Darwin boot",
	"f2" => "DOS secondary",
	"17" => "Hidden HPFS/NTF",
	"64" => "Novell Netware",
	"b7" => "BSDI fs",
	"fd" => "Linux raid auto",
	"18" => "AST SmartSleep",
	"65" => "Novell Netware",
	"b8" => "BSDI swap",
	"fe" => "LANstep",
	"1b" => "Hidden W95 FAT3",
	"70" => "DiskSecure Mult",
	"bb" => "Boot Wizard hid",
	"ff" => "BBT",
	"1c" => "Hidden W95 FAT3",
	"75" => "PC/IX"
    );
    if(defined($Corr{$ID}))
    {
	return($Corr{$ID});
    }
    else
    {
	return($ID);
    }
}



sub Date
{
    my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

    ++ $mon;

    if($sec < 10){ $sec = "0".$sec; }
    if($min < 10){ $min = "0".$min; }
    if($hour < 10){ $hour = "0".$hour; }
    if($mday < 10){ $mday = "0".$mday; }
    if($mon < 10){ $mon = "0".$mon; }
    if($yday < 10){ $yday = "0".$yday; }

    $year += 1900;
    return($year."-".$mon."-".$mday." ".$hour.":".$min.":".$sec);
}



sub Time
{
    my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

    if($sec < 10){ $sec = "0".$sec; }
    if($min < 10){ $min = "0".$min; }
    if($hour < 10){ $hour = "0".$hour; }

    return($hour.":".$min.":".$sec);
}



# Add partimage's log to ping.log. Might help to debug.
#
sub Merge_Partimage_Log
{
    my $PLOG = "/var/log/partimage-debug.log";
    my $i = 0;
    if(-e $PLOG)
    {
	LOG("  Adding [".$PLOG."] to [".$LOG_PATH."]\n");
	LOG("    ------------------------------------------\n");
	open(L, $PLOG);
	while(<L>)
	{
	    # Many, many, quite useless log lines. Eg.:
	    # [Main] image_disk.cpp->read#254: cid: 14336 ; m_qwTotal = 344064
	    # => just keep a few of them.
	    #
	    if(m/m_qwTotal/)
	    {
		++ $i;
		if($i > 6) { next; }
		if($i > 5) { LOG("(...)\n"); }
	    }
	    $i = 0;
	    s/^\s*//;
	    s/\s*$//;
	    LOG("    ".$_."\n");
	}
	close(L);
	LOG("    ------------------------------------------\n");
    }
}



sub Quit
{
    LOG("* Quitting...\n");

    # If a command has been scheduled to be executed before
    # exitting, do so now.
    #
    LOG("  * Any command to execute before exitting ?\n");

    if(defined($P{Cmd_3}) && $P{Cmd_3})
    {
	LOG("    Yes! [".$P{Cmd_3}."]\n");
	my $out = system($P{Cmd_3});
	LOG("    Output: [".$out."]\n");
    }
    else
    {
	LOG("    No defined command.\n");
    }

    # Reboot.
    #
    if($After_Completion =~/reboot/i)
    {
	LOG("  Reboot within 10 seconds !!\a\a\a\n\n");
    }
    elsif($After_Completion =~/shutdown/i)
    {
	LOG("  Shutdown within 10 seconds !!\a\a\a\n\n");
    }
    else
    {
	if(YES($P{No_Shell}))
	{
	    LOG("  No shell allowed. Shutdown within 60 seconds !!\a\a\a\n\n");
	}
	else
	{
	    LOG("  Give the user a shell.\a\a\a\n\n");
	}
    }

    LOG("---------------------------------------------------\n");

    if($SRC =~/cdrom/i)
    {
	LOG("  Hey! Don't forget thy DVD!\a\a\a\n\n");
	system("eject /dev/".$CD_Dev." >/dev/null 2>&1");
	system("eject /mnt/cdrom >/dev/null 2>&1");
    }
    if($After_Completion =~/reboot/i)
    {
	sleep(10);
	system("shutdown -r now");
    }
    elsif($After_Completion =~/shutdown/i)
    {
	sleep(10);
	system("shutdown -h now");
    }
    else
    {
	if(YES($P{No_Shell}))
	{
	    sleep(60);
	    system("shutdown -h now");
	}
	else
	{
#	    Merge_Partimage_Log();

	    system("reset; clear");

	    Show_Logo();

	    print "\nYou are now given the possibility to login to the shell.\n";
	    print "Please, be aware that PING log is stored in ".$LOG_PATH.".\n";

	    Print_Shell_Help();

	    if($P{Image_To_Restore} && $P{Image_To_Restore} !~/^Create_New_Image$/i
		&& $P{Image_To_Restore} !~/^Blank_Local_Admin$/i)
	    {
		print "Last restored image: [".$P{Image_To_Restore}."]\n";
	    }
	    print "\n";

	    exit;
	}
    }
}



# Get parameters from a ping.conf file.
# Returns 1 if at least one parameter has been found.
#
# Syntax: Get_Parameters("/etc/ping.conf", \@CONFIG_FIELDS, \%P);
#
sub Get_Parameters
{
    my $Conf_File = shift || '';
    my $pCONFIG_FIELDS = shift || '';
    my $pP = shift || '';

    return unless($Conf_File && -e $Conf_File && $pCONFIG_FIELDS && $pP);

    my $flag = 0;

    open(DB, $Conf_File) || return;
    while(<DB>)
    {
	s/^\s*//;
	s/\s*$//;
	next unless($_);
	next if(m/^\#/);
	my(@f) = split(/\=/, $_);
	my $V = "";
	if(defined($f[1]))
	{
	    $V = $f[1];
	}
	foreach(2..($#f - 1))
	{
	    if(defined($f[$_]))
	    {
		$V .= "=$f[$_]";
	    }
	}
	foreach($f[0], $V)
	{
	    s/^\s*//;
	    s/\s*$//;
	    s/^\"//;
	    s/\"$//;
	}
	foreach(@{ $pCONFIG_FIELDS })
	{
	    if(lc($_) eq lc($f[0]))
	    {
		$pP->{$_} = $V;
		$flag = 1;
	    }
	}
    }
    close(DB);

    return($flag);
}



# Umount a device.
# Syntax: Umount("/dev/hda1")
#         Umount("/mnt/dos");
#
sub Umount
{
    my($D) = shift || '';
    return unless($D);

#    LOG("Umount> Umounting [".$D."]\n");

    if(Is_Mounted($D))
    {
	Exec_Log("umount ".$D, 0, "Umount> ");
    }
    else
    {
#	LOG("Umount> Not mounted.\n");
    }
}



# Mount a *local* device somewhere. Don't use for a CDRom.
#
# Syntax: Mount("/dev/hda1", "/mnt/dos", "RW");
#         Mount("/dev/hda1", "/mnt/dos", "");
#
sub Mount
{
    my($Dev) = shift || '';
    my($Mnt) = shift || '';
    my($RW) = shift || '';
    return unless($Dev && $Mnt);

    LOG("Mount> Trying to umount [".$Mnt."]\n");
    Umount($Mnt);

    LOG("Mount> Trying to mount [".$Dev."] on [".$Mnt."]\n");

    Exec_Log((Is_NTFS(Part_Type($Dev)) ? $NTFS_MNT:"mount")
	     ." ".$Dev." ".$Mnt, 2, "Mount> ");

    if(! Is_Mounted($Dev) && Is_NTFS(Part_Type($Dev)))
    {
	LOG("Mount> This part could not be mounted.\n");
	LOG("Mount>   Well, it's NTFS... let's fix it, just in case.\n");
	Exec_Log("ntfsfix ".$Dev, 2, "Mount> ");
	Exec_Log($NTFS_MNT." ".$Dev." ".$Mnt, 2, "Mount> ");
    }

    if(! Is_Mounted($Dev))
    {
	LOG("Mount> This part could not be mounted.\n");
	if(Is_NTFS(Part_Type($Dev)))
	{
	    LOG("Mount> Well, it's NTFS...\n");

	    # Sometimes, a NTFS partition cannot be mounted
	    # because Windows has not been shut down properly,
	    # or because it's in hibernation mode. We can detect
	    # this by trying to mount the partition read-only.
	    #
	    LOG("Mount> Maybe we can mount it Read Only ?\n");
	    Umount($Mnt);
	    Exec_Log("mount -o ro -t ".$NTFS_MNT_TYPE." ".$Dev." ".$Mnt, 2, "Mount> ");

	    if(! Is_Mounted($Dev))
	    {
		LOG("Mount> Still not mounted... trying another way\n");
		Umount($Mnt);
		Exec_Log("mount ".$Dev." ".$Mnt, 0, "Mount> ");
	    }
	    if(Is_Mounted($Dev))
	    {
		LOG("Mount> Mounted. Let's tell the user.\n");
		LOG("Mount> \n");
		LOG("Mount> !!! It seems that your partition [".$Dev."]\n");
		LOG("Mount>     can only be mounted in Read Only. It generally\n");
		LOG("Mount>     means that Windows has not been shut down properly\n");
		LOG("Mount>     or is in hibernation mode. We're going to proceed,\n");
		LOG("Mount>     but we won't be able to write data on this part.\n");
		LOG("Mount>     You may reboot now and run chkdsk if necessary.\n");
		LOG("Mount>     Sleeping ".$README_SLEEP." seconds.\n");

		if($RW eq "RW")
		{
		    sleep($README_SLEEP);

		    # Now, we can mount this part R/W if the user really
		    # wants it.
		    #
		    LOG("Mount> Has the user provided a parameter to force R/W"
			." mount ?\n");
		    if(defined($P{Force_Dirty_NTFS_Mount}))
		    {
			LOG("Mount>   Yes! =>[".$P{Force_Dirty_NTFS_Mount}."]\n");
		    }
		    else
		    {
			LOG("Mount>   No. Let's ask.\n");
			my $cmd = 'dialog --colors --menu "\Zb\ZnYour'
			    .' NTFS partition was not clean. The safe'
			    .' choice is to boot Windows and run chkdsk.'
			    .' However, we can mount it read-write and'
			    .' proceed if you want to. Do we ?" 13 50 2 '
			    .' "Yes" "" "No" "" 2>'.$TMPDIR.'/checklist.tmp';
			system($cmd);

			if(-z $TMPDIR."/checklist.tmp")
			{
			    Quit();
			}

			$P{Force_Dirty_NTFS_Mount} = 0;
			open(DB, $TMPDIR."/checklist.tmp");
			while(<DB>)
			{
			    if(m/Y/i)
			    {
				$P{Force_Dirty_NTFS_Mount} = 1;
				last;
			    }
			}
			close(DB);
			unlink($TMPDIR."/checklist.tmp");

			LOG("Mount>   Force_Dirty_NTFS_Mount:"
			    ." [".$P{Force_Dirty_NTFS_Mount}."]\n");
		    }

		    # Correct the way we'll mount NTFS parts if they are dirty and
		    # the user does not want to care about it.
		    #
		    if(YES($P{Force_Dirty_NTFS_Mount}))
		    {
			$NTFS_MNT = "ntfsmount -o force";
			LOG("Mount>   Will now mount NTFS with [".$NTFS_MNT."]\n");
		    }
		}
		else
		{
		    LOG("Mount>   R/W mode not asked for; dont warn the user"
			." too much :)\n");
		}
	    }
	}
    }
}



# Tells if a part is mounted.
# Syntax: Is_Mounted("/dev/sda1");
#         Is_Mounted("sda1");
#         Is_Mounted("/mnt/smbfs");
#
sub Is_Mounted
{
    my($Part) = shift || '';
    return(0) unless($Part);

    $Part =~s/^\/dev\///;

#    LOG("Is_Mounted> Is part [".$Part."] mounted ?\n");

    my $out = `df -P`;
    my(@Lines) = split(/\n/, $out);
    foreach my $L (@Lines)
    {
	my $M = $L;
	$L =~s/ +.*$//;            # /dev/xxx (start of line)
	$M =~s/^.*\s(\S+)$/$1/;    # /mnt/xxx (end of line)
	if($L eq "/dev/".$Part or $M eq $Part)
	{
#	    LOG("Is_Mounted> Yes\n");
	    return(1);
	}
    }

#    LOG("Is_Mounted> No\n");
    return(0);
}



# Tells if a part can be mounted.
# Syntax: Is_Mountable("/dev/sda1");
#         Is_Mountable("sda1");
#
sub Is_Mountable
{
    my($Part) = shift || '';
    return(0) unless($Part);

#    LOG("Is_Mountable> Is [".$Part."] mountable ?\n");

    $Part =~s/^\/dev\///;
    my $MNT = "/mnt/Is_Mountable_".$$;
    if(-d $MNT)
    {
	system("umount ".$MNT." >/dev/null 2>&1");
	system("rm -fr ".$MNT);
    }
    mkdir($MNT, 1775);
    system("mount /dev/".$Part." ".$MNT." >/dev/null 2>&1");
    my $Mounted = Is_Mounted($MNT);
    system("umount ".$MNT." >/dev/null 2>&1");

    if(! $Mounted && Is_NTFS(Part_Type($Part)))
    {
	system("ntfsmount -o force /dev/".$Part." ".$MNT." >/dev/null 2>&1");
	$Mounted = Is_Mounted($MNT);
	system("umount ".$MNT." >/dev/null 2>&1");
    }

#    LOG("Is_Mountable> ".($Mounted ? "Yes":"No")."\n");
    return($Mounted);
}



# Browses a win32/smb directory and find the name of a file,
# whatever the case.
#
sub Find_File_Whatever_Case
{
    my $Dir = shift || '';
    my $File = shift || '';
    return unless($Dir && $File && -d $Dir);

    opendir(DIR, $Dir) || return;
    my(@files) = readdir(DIR);
    closedir(DIR);
    foreach(@files)
    {
	if(m/^$File$/i)
	{
	    return($_);
	}
    }
}



# Tells if a partition is Dell-made
#
sub Is_Dell_Type
{
    my($Type) = shift || '';
    return(($Type eq "db" || $Type eq "de") ? 1:0);
}



# Tells if a partition type is NTFS
#
sub Is_NTFS
{
    my($Type) = shift || '';
    return(($Type eq "7" || $Type eq "42" || $Type eq "86"
	    || $Type eq "87") ? 1:0);
}



# Tells if a partition type is EXT2, EXT3 or EXT4
#
sub Is_EXT
{
    my($Type) = shift || '';
    return(($Type eq "83") ? 1:0);
}



# Tells if a partition type is FAT
#
sub Is_FAT
{
    my($Type) = shift || '';
    return(($Type eq "c" || $Type eq "1e" || $Type eq "1"
	    || $Type eq "4" || $Type eq "6" || $Type eq "b"
	    || $Type eq "c" || $Type eq "e" || $Type eq "ef"
	    || $Type eq "11" || $Type eq "14" || $Type eq "16"
	    || $Type eq "1b" || $Type eq "1c") ? 1:0);
}



# Tells if a partition type is FAT32
#
sub Is_FAT32
{
    my($Type) = shift || '';
    return(($Type eq "b" || $Type eq "c" || $Type eq "1b"
	    || $Type eq "1c") ? 1:0);
}



# Tells if a partition type is FAT16
#
sub Is_FAT16
{
    my($Type) = shift || '';
    return(($Type eq "1e" || $Type eq "4" || $Type eq "6"
	    || $Type eq "e" || $Type eq "14" || $Type eq "16") ? 1:0);
}



# Tells if a partition type is HFS (Apple)
#
sub Is_HFS
{
    my($Type) = shift || '';
    return(($Type eq "a8") ? 1:0);
}



# Tells if Parted can accept this partition type
# (and we don't trust any more parted when they say ext2-3 is
# supported, for it just fails for obscure reasons, while
# resize2fs does not).
#
sub Is_Type_Parted_Compliant
{
    my($Type) = shift || '';
    return((Is_FAT16($Type) || Is_FAT32($Type) || Is_HFS($Type)) ? 1:0);
}



# Tells wether a partition can be resized. We can resize...:
# - NTFS
# - Ext2/3/4
# - what parted can do else, i.e. hsf, fat16 and fat32.
#
# Ex.: if(Is_Resizable("/dev/hda1")) ...
#      if(Is_Resizable("hda1")) ...
#
sub Is_Resizable
{
    my($Part) = shift || '';
    return(0) unless($Part);

    $Part =~s/^\/dev\///;

    return(Is_NTFS(Part_Type($Part))
	   || Is_EXT(Part_Type($Part))
	   || Is_Type_Parted_Compliant(Part_Type($Part)));
}



# Return the type of a filesystem.
# Type can be: reiserfs, ext2, ext3, ntfs, vfat, ?
#
# Ex.: my $FS = FS_Type('/dev/hda1');
#
sub FS_Type
{
    my($Part) = shift || '';
    return(0) unless($Part);

    $Part =~s/^\/dev\///;

    my $MNT = "/mnt/FS_Type_".$$;
    my $flag = 0;

    unless(Is_Mounted($Part))
    {
	if(-e $MNT)
	{
	    system("rm -fr ".$MNT);
	}
	mkdir($MNT, 0755);
	Mount("/dev/".$Part, $MNT, "");
	++ $flag;
    }

    my $cmd = "df -P -T|grep -i ^\/dev\/".$Part."|grep -v grep";
    LOG("FS_Type> Cmd: [".$cmd."]\n");
    my $out = `$cmd`;
    LOG("FS_Type> Out: [".$out."]\n");
    my $fst = '';
    if($out)
    {
	$out =~s/\s+/ /g;
	my(@f) = split(/\s/, $out);
	$fst = defined($f[1]) ? $f[1]:'';
    }
    else
    {
	$fst = '';
    }
    LOG("FS_Type> Found FS type: [".$fst."]\n");

    # Many things can become fuse blocks these days, ntfs-3g included.
    # Fortunately, type-7 parts can only containe a NTFS filesystem.
    #
    if($fst eq "fuseblk" && Is_NTFS(Part_Type($Part)))
    {
	$fst = "ntfs";
	LOG("FS_Type> Rectify to FS type: [".$fst."]\n");
    }

    if($flag)
    {
	Umount($MNT);
	system("rm -fr ".$MNT);
    }

    return($fst);
}



# Tells the device of a mount point.
# Syntax: Dev_Mount_Point("/mnt/dos");   # Returns hda1
#
sub Dev_Mount_Point
{
    my($MPoint) = shift || '';
    return(0) unless($MPoint);

    LOG("Dev_Mount_Point> Device of mount point [".$MPoint."] ?\n");

    my $ret = '';

    my $out = `df -P`;
    my(@lines) = split(/\n/, $out);
    foreach my $L (@lines)
    {
	$L =~s/^\s*$//;
	$L =~s/\s*$//;
	my(@fields) = split(/\s+/, $L);
	if(defined($fields[5]) && $fields[5] eq $MPoint)
	{
	    $ret = $fields[0];
	    $ret =~s/^\/dev\///;
	}
    }

    LOG("Dev_Mount_Point>   Found: [".$ret."]\n");
    return($ret);
}



# Tells if a file has an archive extension (one of these that sub
# Unzip() can handle).
#
sub Is_Archive
{
    my($File) = shift || '';

    if($File =~/\.zip$/i || $File =~/\.tar$/i || $File =~/\.tar\.gz$/i
       || $File =~/\.tar\.bz2$/ || $File =~/\.tar\.7z$/i || $File =~/\.7z$/i
       || $File =~/\.tar\.xz$/)
    {
	return(1);
    }

    return(0);
}



# Tells if we are connected to the network.
#
sub Is_Network_On
{
    my($Eth) = shift || 'eth';
    my $out = `route -n |grep $Eth |wc -l 2>&1`;
    $out =~s/\D//g;
    if($out == 0)
    {
	return(0);
    }
    else
    {
	if($Eth eq 'eth')
	{
	    my(@Eths) = ();
	    $out = `ifconfig |grep ^eth`;
	    my(@lines) = split(/\n/, $out);
	    foreach(@lines)
	    {
		s/^(eth\d+)\D.*$/$1/;
		push(@Eths, $_);
	    }
	    foreach(@Eths)
	    {
		$out = `ifconfig $_`;
		my $IP = '';
		if($out =~/inet add?r\:(\S+)/)
		{
		    $IP = $1;
		}
		if($IP !~/^169\.254\./)
		{
		    return(1);
		}
	    }
	    return(0);
	}
	else
	{
	    $out = `ifconfig $Eth`;
            my $IP = '';
            if($out =~/inet add?r\:(\S+)/)
	    {
		$IP = $1;
	    }
	    if($IP =~/^169\.254\./)
	    {
		return(0);
	    }
	}
    }
    return(1);
}



# Tells if a part is a swap or not.
# Syntax: Is_Swap("/dev/hda1")
#         Is_Swap("hda1")
#
sub Is_Swap
{
    my($Part) = shift || '';
    return(0) unless($Part);

    $Part =~s/^\/dev\///;

    LOG("Is_Swap> Is part [".$Part."] a swap ?\n");

    my $cmd = "swapoff /dev/".$Part." >/dev/null 2>&1;"
	." swapon /dev/".$Part." >/dev/null 2>&1";
    system($cmd);

    my $Out = `free 2>&1`;
    my @L = split(/\n/, $Out);
    foreach my $L (@L)
    {
	$L =~s/^\s*//;
	next unless($L =~/^Swap:/i);
	my(@F) = split(/\s+/, $L);
	if(defined($F[1]) && $F[1] =~/^\d+$/ && $F[1] > 0)
	{
	    system("swapoff /dev/".$Part." >/dev/null 2>&1");
	    LOG("Is_Swap> Yes\n");
	    return(1);
	}
    }

    LOG("Is_Swap> No\n");
    return(0);
}



# Ex.: my $FS = Part_Type("hda1");
#      LOG("  Filesystem ID found: [$FS]\n");  <= 7 for NTFS
#
sub Part_Type
{
    my($Part) = shift || '';
    return(0) unless($Part);

    LOG("Part_Type> Called on part [".$Part."]\n");

    $Part =~s/^\/dev\///;

    # If we've already have it, get id.
    #
    foreach my $D (@Dev_Rich)
    {
	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    if($D->{Parts}->[$i] eq $Part)
	    {
		LOG("Part_Type> Already known: [".$D->{Types}->[$i]."]\n");
		return($D->{Types}->[$i]);
	    }
	}
    }

    # Else, retrieve it.
    #
    my $FS = '';

    my $HDD = HDD_Name($Part);
    LOG("Part_Type> HDD Name: [".$HDD."]\n");

    my $cmd = "fdisk -l /dev/".$HDD." | grep -i ".$Part." >".$TMPDIR."/part_type.$$ 2>&1";
    LOG("Part_Type> cmd: [".$cmd."]\n");
    system($cmd);

    if(-e $TMPDIR."/part_type.$$")
    {
	open(DB, $TMPDIR."/part_type.$$");
	while(<DB>)
	{
	    s/^\s*//;
	    s/\s*$//;
	    s/\*//g;    # Boot flag
	    s/\+//g;    # Blocks addon; does it still happen with sectors?? (>2015)
	    while(m/\s\s/)
	    {
		s/\s\s/ /g;
	    }
	    $FS = (split(/ /, $_))[5];
	}
	close(DB);
	unlink($TMPDIR."/part_type.$$");
    }

    LOG("Part_Type> FS, finally: [".$FS."]\n");
    return($FS);
}



# Ex.: my $HDD = HDD_Name('hda1');         # returns 'hda'
#      my $HDD = HDD_Name('cciss/c0d0p1'); # returns 'c0d0'
#      my $HDD = HDD_Name('/dev/hda1');    # returns 'hda'
#      my $HDD = HDD_Name('/dev/mapper/VolGroup00-LogVol00');  # returns 'VolGroup00'
#      my $HDD = HDD_Name('/dev/md126p1'); # returns 'md126'
#
sub HDD_Name
{
    my $HDD = shift || '';
    $HDD =~s/^\/dev\///;
    if($HDD =~/^(cciss|rd|ida|mapper|md)/)
    {
	$HDD =~s/p\d+$//;
	$HDD =~s/\-LogVol\d+$//;
    }
    else
    {
	$HDD =~s/\d+$//;
    }
    return($HDD);
}



# Ex.: Part_Number('/dev/hda1');                  # returns 1
#      Part_Number('cciss/c0d0p2');               # returns 2
#      Part_Number('mapper/VolGroup00-LogVol00'); # returns 00
#      Part_Number('/dev/md126p1');               # returns 1
#
sub Part_Number
{
    my($pnum) = shift || '';
    $pnum =~s/^.*\D(\d+)$/$1/;
    $pnum = '' unless($pnum =~/^\d+$/);
    return($pnum);
}



# Ex.: assuming hda contains 3 parts
#      Nb_Parts('/dev/hda');  # returns 3
#      Nb_Parts('hda');       # returns 3
#
sub Nb_Parts
{
    my($Dev) = shift || '';
    $Dev =~s/^\/dev\///;
    my $cnt = `fdisk -l /dev/$Dev |grep ^\/dev\/$Dev |wc -l`;
    $cnt =~s/\D//g;
    return($cnt);
}



# Ex.: Is_Part_Extended(5);   # returns 1
#
# Extended types are:
#   "5" => "Extended",
#   "85" => "Linux extended c7 Syrinx",
#   "f" => "W95 Ext'd (LBA)",
#
sub Is_Part_Extended
{
    my($Type) = shift || '';
    if($Type eq '5' || $Type eq 'f' || $Type eq '85')
    {
	return(1);
    }
    else
    {
	return(0);
    }
}



# Tells if a partition is contained in an ext'd part, and returns
# the number of the containing ext'd part. Returns -1 if primary.
#
# Ex.: $i = Is_Part_Logical(2, $D);  # $D from @Dev_Rich
#
sub Is_Part_Logical
{
    my $p = shift || '';
    my $D = shift || '';

    return unless($p ne '' && $D);

    $D =~s/^\/dev\///;

    LOG("IPLogic> Is part [".$p."] logical ? Dev [".$D->{Dev}."]\n");
    LOG("IPLogic> Identifying ext'd parts\n");

    my(@Extd) = ();
    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
    {
	if(Is_Part_Extended($D->{Types}->[$i]))
	{
	    push(@Extd, $i);
	}
    }

    LOG("IPLogic>   Extd parts:\n");
    foreach(@Extd)
    {
	LOG("IPLogic>     [".$_."] => [".$D->{Parts}->[$_]."]\n");
    }

    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
    {
	my $In_Extd = 0;
	foreach my $d (@Extd)
	{
	    if($D->{Start}->[$i] >= $D->{Start}->[$d]
	       && $D->{End}->[$i] <= $D->{End}->[$d]
	       && $i != $d && $i == $p)
	    {
		LOG("IPLogic>       Part [".$i."] ["
		    .$D->{Parts}->[$i]."] in extd part [".$d."]\n");
		return($d);
	    }
	}
    }

    LOG("IPLogic>   It's a primary part.\n");
    return(-1);
}



# Apply modifications to the partition table.
# Just like calling fdisk /dev/hda and w.
#
sub Synchronize_Device
{
    my($Dev) = shift || '';
    return unless($Dev);
    $Dev =~s/^\/dev\///;

    # Not any more possible;
    # `sfdisk -R /dev/$Dev`;
    # Alternative: `sync`; but, will sync everything instead.

    `partprobe /dev/$Dev`;

    if(Is_In_Path("udevadm"))
    {
	`udevadm trigger`;
    }
    elsif(Is_In_Path("udevtrigger"))
    {
	`udevtrigger`;
    }
}



# Tells how much space is used in a mountable partition.
# Returns a number of bytes.
#
# Ex.: Used_Space("/dev/hda1", 0);
#
sub Used_Space
{
    my($d) = shift;
    my($Without_Useless_Files) = shift;
    return(0) unless(defined($d) && $d);
    $Without_Useless_Files = 0 unless(defined($Without_Useless_Files)
				      && $Without_Useless_Files);

    LOG("Used_Space> Called on dev [".$d."]\n");
    LOG("Used_Space> Without useless files ? [".$Without_Useless_Files."]\n");

    $d =~s/^\/dev\///;

    my $Already_Mounted = Is_Mounted("/dev/".$d);
    my $MNT = "/mnt/Used_Space_".$$;

    if($Already_Mounted)
    {
	my $cmd = "df -P 2>&1 | grep -i ".$d;
	LOG("Used_Space> Cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("Used_Space> Out: [".$out."]\n");
	$out =~s/^\s*//;
	$out =~s/\s*$//;
	$out =~s/\s+/ /g;
	$MNT = (split(/ /, $out))[5];
	LOG("Used_Space> Mount point: [".$MNT."]\n");
    }
    else
    {
	Umount($MNT);
	if(-d $MNT)
	{
	    system("rm -fr ".$MNT);
	}
	mkdir($MNT, 0755);
	Mount("/dev/".$d, $MNT, "");
    }

    my $Used_Space = 0;
    my $cmd = "df -P 2>&1 | grep -i ".$d;
    LOG("Used_Space> Cmd: [".$cmd."]\n");
    my $out = `$cmd`;
    LOG("Used_Space> Out: [".$out."]\n");
    $out =~s/\s+/ /g;
    $Used_Space = (split(/ /, $out))[2] * 1024;

    unless($Already_Mounted)
    {
	Umount($MNT);
	system("rm -fr ".$MNT);
    }

    my $Useless_Space = 0;
    if($Without_Useless_Files)
    {
	foreach my $file ("pagefile.sys", "hiberfil.sys", "swapfile.sys")
	{
	    if(-e $MNT."/".$file)
	    {
		$Useless_Space += (stat($MNT."/".$file))[7];
	    }
	}
	LOG("Used_Space> Useless space: [".$Useless_Space."]\n");
    }

    LOG("Used_Space> Used space found (1) [".$Used_Space."]\n");
    $Used_Space -= $Useless_Space;
    LOG("Used_Space> Used space found (2) [".$Used_Space."]\n");

    return($Used_Space);
}



# Find out the minimum size a partition can be reduced to.
# Will use ntfsresize if NTFS, parted else.
# Returns a number of bytes.
#
# Syntax: my $Min_Size = Part_Minimum_Size("/dev/hda1");
#
sub Part_Minimum_Size
{
    my($D) = shift || '';
    return(0) unless($D);

    LOG("Part_Minimum_Size> Called on dev [".$D."]\n");

    $D =~s/^\/dev\///;

    unless(Is_Resizable($D))
    {
	LOG("Part_Minimum_Size> Filesystem of [".$D."] is not handled.\n");
	return(0);
    }

    my $Min_Size = 0;

    if(Is_NTFS(Part_Type($D)))
    {
	my $cmd = "(echo y|ntfsresize -i -f /dev/".$D.") 2>&1";
	LOG("Part_Minimum_Size> Cmd: [".$cmd."]\n");
	system($cmd);
	my $out = `$cmd`;
	LOG("Part_Minimum_Size> Out: [".$out."]\n");

	my(@lines) = split(/\n/, $out);
	foreach(@lines)
	{
	    if(m/^You might resize at/i)
	    {
		$Min_Size = $_;
		$Min_Size =~s/^\D+([0-9]+)\sbytes.*$/$1/;
		$Min_Size =~s/\D//g;
		LOG("Part_Minimum_Size> NTFS / Can reduce to [".$Min_Size."] bytes\n");
		last;
	    }
	}
    }
    else
    {
	my $cmd = 'echo -e "unit cyl\nprint '.Part_Number($D)
	    .'\nq\n"| parted /dev/'.HDD_Name($D).' 2>&1';
	LOG("Part_Minimum_Size> Cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("Part_Minimum_Size> Out: [".$out."]\n");

	my(@lines) = split(/\n/, $out);
	foreach(@lines)
	{
	    if(m/^Minimum size/i)
	    {
		s/^\s*//;
		s/\s*$//;
		$Min_Size = $_;
		$Min_Size =~s/^Minimum size:\s*(\S+).*$/$1/i;
		last;
	    }
	}
	if($Min_Size =~/KB$/)
	{
	    $Min_Size =~s/[^0-9\.]//g;
	    $Min_Size *= 1024;
	}
	elsif($Min_Size =~/MB$/)
	{
	    $Min_Size =~s/[^0-9\.]//g;
	    $Min_Size *= 1024 * 1024;
	}
	elsif($Min_Size =~/GB$/)
	{
	    $Min_Size =~s/[^0-9\.]//g;
	    $Min_Size *= 1024 * 1024 * 1024;
	}

	LOG("Part_Minimum_Size> not NTFS / Can reduce to [".$Min_Size."] bytes\n");
    }

    return($Min_Size);
}



# Will resize the *filesystem* contained in a partition.
# Will use ntfsresize if NTFS, parted else.
# Returns 1 in case of failure, and 2 if the FS is not supported.
# Succes => returns 0.
#
# Note: parted also adjusts the partition table, and ntfsresize does not.
#       This sub won't bother with fdisk.
#
# Note: The number of cylinders could be calculated through the number
#       of bytes, but parted and fdisk will blow up fat partitions if
#       bytes are given to parted, and cylinders to fdisk, because of
#       a small size difference. So, give cyls to everyone.
#
# Syntax: FS_Resize("/dev/hda1", 800000000/512, 800000000);
#                     dev, number of sectors, number of bytes
#
sub FS_Resize
{
    my($D) = shift || '';
    my($New_Size_Sectors) = shift || '';
    my($New_Size_Bytes) = shift || '';
    return(0) unless($D && $New_Size_Sectors ne '' && $New_Size_Bytes ne '');

    LOG("FS_Resize> Called on dev [".$D."] / Resize to [".$New_Size_Sectors."] sectors\n");
    LOG("FS_Resize>   or [".$New_Size_Bytes."] bytes\n");
    LOG("\n");
    LOG("FS_Resize> PING is going to resize this partition.\n");
    for(1..3)
    {
	LOG("FS_Resize> /!\\ DON'T SHUTDOWN until PING has finished!!\n");
    }
    LOG("\n");

    sleep($INFO_SLEEP);

    $D =~s/^\/dev\///;

    unless(Is_Resizable($D))
    {
	LOG("FS_Resize> The filesystem of [".$D."] is not handled. Won't resize.\n");
	return(2);
    }

    if(Is_NTFS(Part_Type($D)))
    {
	my $cmd = "(echo y|ntfsresize -f -s ".$New_Size_Bytes." /dev/".$D.") 2>&1";
	LOG("FS_Resize> Cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("FS_Resize> Out: [".$out."]\n");
	if($out =~/error/i)
	{
	    return(1);
	}
    }
    elsif(Is_EXT(Part_Type($D)))
    {
	my $cmd = "resize2fs -f /dev/".$D." "
	    .int($New_Size_Bytes / 512)."s 2>&1";
	LOG("FS_Resize> Cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("FS_Resize> Out: [".$out."]\n");
	if($out =~/error/i)
	{
	    return(1);
	}
    }
    else
    {
	# GNU Parted 1.8.8
	# Using /dev/hda
	# Welcome to GNU Parted! Type 'help' to view a list of commands.
	# (parted) Model: VMware Virtual IDE Hard Drive (ide)
	# Disk /dev/hda: 85.9GB
	# Sector size (logical/physical): 512B/512B
	# Partition Table: msdos
	#
	# Number  Start   End       Size      Type     File system  Flags
	#  1      0cyl    10442cyl  10442cyl  primary  fat32        lba  
	#
	# OR, if unit s:
	#
	# Number  Start   End         Size        Type     File system  Flags
	#  1      0s      125827071s  125827071s  primary  ntfs
	#
	my $cmd = 'echo -e "unit s\nprint\nq"| parted /dev/'
	    .HDD_Name($D).' 2>&1';
	LOG("FS_Resize> Cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("FS_Resize> Out: [".$out."]\n");

	my $Start = 0;
	my(@lines) = split(/\n/, $out);
	my $flag = 0;
	foreach(@lines)
	{
	    s/^\s*//;
	    s/\s*$//;
	    if(m/^Number/i)
	    {
		++ $flag;
		next;
	    }
	    if($flag)
	    {
		my(@F) = split(/\s+/, $_);
		if(defined($F[0]) && $F[0] eq Part_Number($D))
		{
		    $Start = $F[1];
		}
	    }
	}
	LOG("FS_Resize> Partition start: [".$Start."]\n");

	$Start =~s/\D//g;
	my $End = $Start + $New_Size_Sectors;

	LOG("FS_Resize> Partition start: [".$Start."] sectors\n");
	LOG("FS_Resize> Partition future end: [".$End."] sectors\n");

	$cmd = 'echo -e "resize '.Part_Number($D)
	    .' '.$Start.'s '.$End.'s\nq"| parted /dev/'.HDD_Name($D);
	LOG("FS_Resize> Cmd: [".$cmd."]\n");
	$out = `$cmd`;
	LOG("FS_Resize> Out: [".$out."]\n");
	if($out =~/error/i)
	{
	    return(1);
	}
    }

    return(0);
}



# Find out the maximum size a filesystem can be raised to.
# Will use ntfsresize if NTFS, parted else.
# Returns a number of bytes.
#
# Syntax: my $Max_Size = FS_Maximum_Size("/dev/hda1", "hda", 512);
#
sub FS_Maximum_Size
{
    my($D) = shift || '';
    my($Dev) = shift || '';
    my($BIOS_Sector_Size) = shift || 0;

    return(0) unless($D && $Dev && $BIOS_Sector_Size);

    LOG("FS_Maximum_Size> Called on part [".$D."], device ["
	.$Dev."], BIOS Sector Size [".$BIOS_Sector_Size."]\n");

    $D =~s/^\/dev\///;

    unless(Is_Resizable($D))
    {
	LOG("FS_Maximum_Size> Filesystem of [".$D."] is not handled.\n");
	return(0);
    }

    my $Max_Size = 0;

    if(Is_NTFS(Part_Type($D)))
    {
	LOG("FS_Maximum_Size> NTFS!\n");

	my $cmd = "ntfsfix /dev/".$D." 2>&1";
	LOG("FS_Maximum_Size> Cmd: [".$cmd."]\n");
	system($cmd);

	$cmd = "(echo y|ntfsresize -i -f /dev/".$D.") 2>&1";
	LOG("FS_Maximum_Size> Cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("FS_Maximum_Size> Out: [".$out."]\n");

	my(@Lines) = split(/\n/, $out);
	my $CurVol = 0;
	my $CurDev = 0;
	foreach(@Lines)
	{
	    if(m/Current volume size/i)
	    {
		$CurVol = $_;
	    }
	    elsif(m/Current device size/i)
	    {
		$CurDev = $_;
	    }
	}
	foreach($CurVol, $CurDev)
	{
	    s/^.* ([0-9]+) bytes.*$/$1/;
	}
	LOG("FS_Maximum_Size> Current volume size: [".$CurVol."]\n");
	LOG("FS_Maximum_Size> Current device size: [".$CurDev."]\n");

	$Max_Size = $CurDev;

        LOG("FS_Maximum_Size> We can raise the volume size to [".$Max_Size."]!\n");
    }
    elsif(Is_EXT(Part_Type($D)))
    {
	LOG("FS_Maximum_Size> EXT2/3/4!\n");

	my $cmd = "fdisk -l /dev/".$Dev." |grep ".$D." 2>&1";
	LOG("FS_Maximum_Size> cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("FS_Maximum_Size> out: [".$out."]\n");
	$out =~s/^\s*//;
	$out =~s/\s*$//;
	$out =~s/\*//;      # Boot flag
	my(@f) = split(/\s+/, $out);
	if(defined($f[3]))
	{
	    $Max_Size = $f[3];
	    $Max_Size =~s/\D//g;
	    $Max_Size *= $BIOS_Sector_Size;
	}

        LOG("FS_Maximum_Size> We can raise the volume size to [".$Max_Size."]!\n");
    }
    else
    {
	# Forget other filesystems.
	#
	LOG("FS_Maximum_Size> This filesystem type is not supported. Faking.\n");

	my $CurDev = FS_Size($D);
	my $CurVol = $CurDev;

	my $Max_Size = $CurDev;

	LOG("FS_Maximum_Size> not NTFS / Can raise to [".$Max_Size."] bytes\n");
    }

    return($Max_Size);
}



# Find out the current size of a filesystem.
# Will use ntfsresize if NTFS, parted else.
# Returns a number of bytes.
#
# Syntax: my $FS_Size = FS_Size("/dev/hda1");
#
sub FS_Size
{
    my($D) = shift || '';
    return(0) unless($D);

    LOG("FS_Size> Called on dev [".$D."]\n");

    $D =~s/^\/dev\///;

    unless(Is_Resizable($D))
    {
	LOG("FS_Size> Filesystem of [".$D."] is not handled.\n");
	return(0);
    }

    my $Cur_Size = 0;

    if(Is_NTFS(Part_Type($D)))
    {
	my $cmd = "ntfsfix /dev/".$D." 2>&1";
	LOG("FS_Size> Cmd: [".$cmd."]\n");

	$cmd = "echo y|ntfsresize -i -f /dev/".$D." 2>&1";
	LOG("FS_Size> Cmd: [".$cmd."]\n");
	system($cmd);
	my $out = `$cmd`;
	LOG("FS_Size> Out: [".$out."]\n");

	my(@Lines) = split(/\n/, $out);
	foreach(@Lines)
	{
	    if(m/Current volume size/i)
	    {
		$Cur_Size = $_;
	    }
	}
	$Cur_Size =~s/^.* ([0-9]+) bytes.*$/$1/;

	LOG("FS_Size> NTFS / Size: [".$Cur_Size."] bytes\n");
    }
    elsif(Is_EXT(Part_Type($D)))
    {
	Mount("/dev/".$D, "/mnt/win", "");
	my $cmd = "df -BK|grep ^\/dev\/".$D;
	LOG("FS_SIZE> cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("FS_SIZE> out: [".$out."]\n");
	$out =~s/^\s*//;
	$out =~s/\s*$//;
	my(@f) = split(/\s+/, $out);
	if(defined($f[1]))
	{
	    $Cur_Size = $f[1];
	    $Cur_Size =~s/K$//i;
	    $Cur_Size *= 1024;
	}
	Umount("/mnt/win");
	LOG("FS_Size> EXT / Size: [".$Cur_Size."] bytes\n");
    }
    else
    {
	# This is all false. We want the real size of the filesystem,
	# and parted retrieves the size of the partition.
	#
	# Keep that; we only want to resize NTFS and EXT2/3/4 filesystems.
	#
	my $cmd = 'echo -e "unit b\nprint\nq\n"| parted /dev/'.HDD_Name($D).' 2>&1';
	LOG("FS_Size> Cmd: [".$cmd."]\n");
	my $out = `$cmd`;
	LOG("FS_Size> Out: [".$out."]\n");

	my(@lines) = split(/\n/, $out);
	my $flag = 0;
	foreach(@lines)
	{
	    s/^\s*//;
	    s/\s*$//;
	    if(m/^Number/)
	    {
		++ $flag;
		next;
	    }
	    my $PN = Part_Number($D);
	    if($flag && m/^$PN\s+/)
	    {
		my(@f) = split(/^\s+/, $_);
		if(defined($f[3]) && $f[3] =~/^\d+B?$/)
		{
		    $Cur_Size = $f[3];
		    $Cur_Size =~s/B//;
		}
		last;
	    }
	}

	LOG("FS_Size> not NTFS / Size: [".$Cur_Size."] bytes\n");
    }

    return($Cur_Size);
}



# Looks for a file somewhere in the system path.
#
sub Is_In_Path
{
    my $Bin = shift || '';
    return(0) unless($Bin);
    foreach(split(/:/, $ENV{PATH}))
    {
	if(-e $_."/".$Bin)
	{
	    return(1);
	}
    }
    return(0);
}



# Returns the correct way to unarchive a file.
# Ex.: system(Unzip($Path));
#      If $Path is "file.zip", returns "unzip \"file.zip\"".
#
sub Unzip
{
    my $Path = shift || '';
    return("# No Path") unless($Path);

    # Prefer star to tar, as it's faster and should handle
    # ACLs better (except for NTFS).

    my $STar = Is_In_Path("star");

    if($Path =~/\.zip$/i)
    {
	return("unzip \"".$Path."\"");
    }
    elsif($Path =~/\.tar$/i)
    {
	return(($STar ? "s":"")."tar xvf \"".$Path."\"");
    }
    elsif($Path =~/\.tar\.gz$/i)
    {
	return(($STar ? "star xvf":"tar xvfz")." \"".$Path."\"");
    }
    elsif($Path =~/\.tar\.bz2$/i)
    {
	return(($STar ? "star xvf":"bzip2 -d -c")
	       ." \"".$Path."\"".($STar ? "":"|tar xvf -"));
    }
    elsif($Path =~/\.tar\.xz$/i)
    {
	return(($STar ? "star xvf":"xz -d")
	       ." \"".$Path."\"".($STar ? "":"|tar xvf -"));
    }
    elsif($Path =~/\.tar\.7z$/i)
    {
	return("7za x -y -so \"".$Path."\"|".($STar ? "s":"")."tar xvf -");
    }
    elsif($Path =~/\.7z$/i)
    {
	return("7za x -y \"".$Path."\"");
    }

    return("# No idea");
}



# Display the results of the HDD discovery.
#
sub HDD_Describe
{
    my $pD = shift;
    foreach my $D (@{ $pD })
    {
	LOG("HDD_Describe> Device: [".$D->{Dev}."]\n");
	if(defined($D->{Heads}))
	{
	    LOG("HDD_Describe>   P.Table-read Heads: [".$D->{Heads}."]\n");
	}
	if(defined($D->{Sectors_Track}))
	{
	    LOG("HDD_Describe>   P.Table-read Sectors/track: ["
		.$D->{Sectors_Track}."]\n");
	}
	if(defined($D->{Cylinders}))
	{
	    LOG("HDD_Describe>   P.Table-read Cylinders: [".$D->{Cylinders}."]\n");
	}
	if(defined($D->{BIOS_Heads}))
	{
	    LOG("HDD_Describe>   BIOS-read Heads: [".$D->{BIOS_Heads}."]\n");
	}
	if(defined($D->{BIOS_Sectors_Track}))
	{
	    LOG("HDD_Describe>   BIOS-read Sectors/track: ["
		.$D->{BIOS_Sectors_Track}."]\n");
	}
	if(defined($D->{BIOS_Cylinders}))
	{
	    LOG("HDD_Describe>   BIOS-read Cylinders: [".$D->{BIOS_Cylinders}."]\n");
	}
	if(defined($D->{BIOS_Sector_Size}))
	{
	    LOG("HDD_Describe>   BIOS-read Sector Size: [".$D->{BIOS_Sector_Size}."]\n");
	}
	if(defined($D->{BIOS_Block_Size}))
	{
	    LOG("HDD_Describe>   BIOS-read Block Size: [".$D->{BIOS_Block_Size}."]\n");
	}
	if(defined($D->{BIOS_Dev_Size}))
	{
	    LOG("HDD_Describe>   BIOS-read Dev Size: [".$D->{BIOS_Dev_Size}."]\n");
	}

	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    foreach("Parts", "Types", "FS_Types", "Dirs", "Labels",
		    "Boot_Flags", "Start", "End", "Sectors", "Size",
		    "Used_Space")
	    {
		$D->{$_}->[$i] = "" unless(defined($D->{$_}->[$i]));
	    }
	    LOG("HDD_Describe>   Partition [".$i."]\n");
	    LOG("HDD_Describe>     Name: [".$D->{Parts}->[$i]."]\n");
	    LOG("HDD_Describe>     Type: [".$D->{Types}->[$i]."]\n");
	    LOG("HDD_Describe>     FS_Type: [".$D->{FS_Types}->[$i]."]\n");
	    LOG("HDD_Describe>     Dirs: [".$D->{Dirs}->[$i]."]\n");
	    LOG("HDD_Describe>     Label: [".$D->{Labels}->[$i]."]\n");
	    LOG("HDD_Describe>     Boot flag: [".$D->{Boot_Flags}->[$i]."]\n");
	    LOG("HDD_Describe>     Start: [".$D->{Start}->[$i]."]\n");
	    LOG("HDD_Describe>     End: [".$D->{End}->[$i]."]\n");
	    LOG("HDD_Describe>     Sectors: [".$D->{Sectors}->[$i]."]\n");
	    LOG("HDD_Describe>     Size: [".$D->{Size}->[$i]."]\n");
	    LOG("HDD_Describe>     Used_Space: [".$D->{Used_Space}->[$i]."]\n");
	}
    }
}



# Sends back the exact look of the drive(s)
#
sub HDD_Exact_Look
{
    my $pD = shift;

    my $Out = '';
    foreach my $D (@{ $pD })
    {
	$Out .= "--------------------fdisk start Device [".$D->{Dev}."]\n";
	$Out .= `fdisk -l /dev/$D->{Dev}`;
	$Out .= "--------------------fdisk end Device [".$D->{Dev}."]\n";
	$Out .= "--------------------ping start Device [".$D->{Dev}."]\n";
	$Out .= "P.Table-read Heads: [".$D->{Heads}."]\n";
	$Out .= "P.Table-read Sectors/track: [".$D->{Sectors_Track}."]\n";
	$Out .= "P.Table-read Cylinders: [".$D->{Cylinders}."]\n";
	$Out .= "BIOS-read Heads: [".$D->{BIOS_Heads}."]\n";
	$Out .= "BIOS-read Sectors/track: [".$D->{BIOS_Sectors_Track}."]\n";
	$Out .= "BIOS-read Cylinders: [".$D->{BIOS_Cylinders}."]\n";
	$Out .= "BIOS-read Sector Size: [".$D->{BIOS_Sector_Size}."]\n";
	$Out .= "BIOS-read Block Size: [".$D->{BIOS_Block_Size}."]\n";
	$Out .= "BIOS-read Dev Size: [".$D->{BIOS_Dev_Size}."]\n";

	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    $Out .= "--------------------ping start Partition [".$i."]\n";
	    $Out .= "Name: [".$D->{Parts}->[$i]."]\n";
	    $Out .= "Type: [".$D->{Types}->[$i]."]\n";
	    $Out .= "FS_Type: [".$D->{FS_Types}->[$i]."]\n";
	    $Out .= "Dirs: [".$D->{Dirs}->[$i]."]\n";
	    $Out .= "Label: [".$D->{Labels}->[$i]."]\n";
	    $Out .= "Boot flag: [".$D->{Boot_Flags}->[$i]."]\n";
	    $Out .= "Start: [".$D->{Start}->[$i]."]\n";
	    $Out .= "End: [".$D->{End}->[$i]."]\n";
	    $Out .= "Sectors: [".$D->{Sectors}->[$i]."]\n";
	    $Out .= "Size: [".$D->{Size}->[$i]."]\n";
	    $Out .= "Used_Space: [".$D->{Used_Space}->[$i]."]\n";
	    $Out .= "--------------------ping end Partition [".$i."]\n";
	}

	$Out .= "--------------------ping end Device [".$D->{Dev}."]\n";
    }

    return($Out);
}



# Sends back the exact look of the drive(s)
# not too proud about the quality of the code... :p
#
sub HDD_Get_From_Exact_Look
{
    my $Path = shift || '';
    my $pD = shift;

    LOG("HDD_GFEL> Path to HDD_Look: [".$Path."]\n");

    unless(defined($Path) && $Path && defined($pD) && -e $Path)
    {
	LOG("HDD_GFEL> ! Bad arguments sent to the sub.\n");
	unless(defined($pD))
	{
	    LOG("HDD_GFEL>   \$pD not defined\n");
	}
	return();
    }

    @{ $pD } = ();

    my $Loc = '';

    my $Dev = '';
    my $Dev_Heads = 0;
    my $Dev_Sectors_Track = 0;
    my $Dev_Cylinders = 0;
    my $BIOS_Heads = 0;
    my $BIOS_Sectors_Track = 0;
    my $BIOS_Cylinders = 0;
    my $BIOS_Sector_Size = 0;
    my $BIOS_Block_Size = 0;
    my $BIOS_Dev_Size = 0;
    my $Parts = '';
    my $Types = '';
    my $FS_Types = '';
    my $Dirs = '';
    my $Labels = '';
    my $Boot_Flags = '';
    my $Start = '';
    my $End = '';
    my $Sectors = '';
    my $Size = '';
    my $Used_Space = '';

    open(D, $Path);
    while(<D>)
    {
	s/^\s*//;
	s/\s*$//;
	my $Line = $_;

	if($Line =~/--------------------ping start Device \[/)
	{
	    LOG("HDD_GFEL>   Line [".$Line."]\n");

	    $Dev = $Line;
	    $Dev =~s/--------------------ping start Device \[//;
	    $Dev =~s/\].*//;
	    $Dev =~s/\s//g;

	    $Dev_Heads = 0;
	    $Dev_Sectors_Track = 0;
	    $Dev_Cylinders = 0;
	    $BIOS_Heads = 0;
	    $BIOS_Sectors_Track = 0;
	    $BIOS_Cylinders = 0;
	    $BIOS_Sector_Size = 0;
	    $BIOS_Block_Size = 0;
	    $BIOS_Dev_Size = 0;
	    $Parts = '';
	    $Types = '';
	    $FS_Types = '';
	    $Dirs = '';
	    $Labels = '';
	    $Boot_Flags = '';
	    $Start = '';
	    $End = '';
	    $Sectors = '';
	    $Size = '';
	    $Used_Space = '';

	    LOG("HDD_GFEL>   Device [".$Dev."]\n");
	}
	elsif($Line =~/--------------------ping start Partition \[/)
	{
	    my $Part = $Line;
	    $Part =~s/--------------------ping start Partition \[//;
	    $Part =~s/\].*//;
	    $Part =~s/\s//g;

	    LOG("HDD_GFEL>     Partition [".$Part."]\n");
	}
	elsif($Line =~/--------------------ping end Device \[/)
	{
	    LOG("HDD_GFEL>   End of info about Device [".$Dev."]\n");

	    my(%Rich) = ();
	    $Rich{Dev} = $Dev;
	    $Rich{Heads} = $Dev_Heads;
	    $Rich{Sectors_Track} = $Dev_Sectors_Track;
	    $Rich{Cylinders} = $Dev_Cylinders;
	    $Rich{BIOS_Heads} = $BIOS_Heads;
	    $Rich{BIOS_Sectors_Track} = $BIOS_Sectors_Track;
	    $Rich{BIOS_Cylinders} = $BIOS_Cylinders;
	    $Rich{BIOS_Sector_Size} = $BIOS_Sector_Size;
	    $Rich{BIOS_Block_Size} = $BIOS_Block_Size;
	    $Rich{BIOS_Dev_Size} = $BIOS_Dev_Size;
	    $Rich{Parts} = $Parts;
	    $Rich{Types} = $Types;
	    $Rich{FS_Types} = $FS_Types;
	    $Rich{Dirs} = $Dirs;
	    $Rich{Labels} = $Labels;
	    $Rich{Boot_Flags} = $Boot_Flags;
	    $Rich{Start} = $Start;
	    $Rich{End} = $End;
	    $Rich{Sectors} = $Sectors;
	    $Rich{Size} = $Size;
	    $Rich{Used_Space} = $Used_Space;

	    push(@{ $pD }, \%Rich);
	}
	else
	{
	    if($Line =~/P\.Table\-read Heads:/)
	    {
		$Dev_Heads = $Line;
		$Dev_Heads =~s/P\.Table\-read Heads: \[//;
		$Dev_Heads =~s/\].*//;
		$Dev_Heads =~s/\s//g;

		LOG("HDD_GFEL>     P.Table-read Heads: [".$Dev_Heads."]\n");
	    }
	    elsif($Line =~/P\.Table\-read Sectors\/track:/)
	    {
		$Dev_Sectors_Track = $Line;
		$Dev_Sectors_Track =~s/P\.Table\-read Sectors\/track: \[//;
		$Dev_Sectors_Track =~s/\].*//;
		$Dev_Sectors_Track =~s/\s//g;

		LOG("HDD_GFEL>     P.Table-read Sectors/track: [".$Dev_Sectors_Track."]\n");
	    }
	    elsif($Line =~/P\.Table\-read Cylinders:/)
	    {
		$Dev_Cylinders = $Line;
		$Dev_Cylinders =~s/P\.Table\-read Cylinders: \[//;
		$Dev_Cylinders =~s/\].*//;
		$Dev_Cylinders =~s/\s//;

		LOG("HDD_GFEL>     P.Table-read Cylinders: [".$Dev_Cylinders."]\n");
	    }
	    if($Line =~/BIOS-read Heads:/)
	    {
		$BIOS_Heads = $Line;
		$BIOS_Heads =~s/BIOS-read Heads: \[//;
		$BIOS_Heads =~s/\].*//;
		$BIOS_Heads =~s/\s//g;

		LOG("HDD_GFEL>     BIOS-read Heads: [".$BIOS_Heads."]\n");
	    }
	    elsif($Line =~/BIOS-read Sectors\/track:/)
	    {
		$BIOS_Sectors_Track = $Line;
		$BIOS_Sectors_Track =~s/BIOS-read Sectors\/track: \[//;
		$BIOS_Sectors_Track =~s/\].*//;
		$BIOS_Sectors_Track =~s/\s//g;

		LOG("HDD_GFEL>     BIOS-read Sectors/track: [".$BIOS_Sectors_Track."]\n");
	    }
	    elsif($Line =~/BIOS-read Cylinders:/)
	    {
		$BIOS_Cylinders = $Line;
		$BIOS_Cylinders =~s/BIOS-read Cylinders: \[//;
		$BIOS_Cylinders =~s/\].*//;
		$BIOS_Cylinders =~s/\s//;

		LOG("HDD_GFEL>     BIOS-read Cylinders: [".$BIOS_Cylinders."]\n");
	    }
	    elsif($Line =~/BIOS-read Sector Size:/)
	    {
		$BIOS_Sector_Size = $Line;
		$BIOS_Sector_Size =~s/BIOS-read Sector Size: \[//;
		$BIOS_Sector_Size =~s/\].*//;
		$BIOS_Sector_Size =~s/\s//;

		LOG("HDD_GFEL>     BIOS-read Sector Size: [".$BIOS_Sector_Size."]\n");
	    }
	    elsif($Line =~/BIOS-read Block Size:/)
	    {
		$BIOS_Block_Size = $Line;
		$BIOS_Block_Size =~s/BIOS-read Block Size: \[//;
		$BIOS_Block_Size =~s/\].*//;
		$BIOS_Block_Size =~s/\s//;

		LOG("HDD_GFEL>     BIOS-read Block Size: [".$BIOS_Block_Size."]\n");
	    }
	    elsif($Line =~/BIOS-read Dev Size:/)
	    {
		$BIOS_Dev_Size = $Line;
		$BIOS_Dev_Size =~s/BIOS-read Dev Size: \[//;
		$BIOS_Dev_Size =~s/\].*//;
		$BIOS_Dev_Size =~s/\s//;

		LOG("HDD_GFEL>     BIOS-read Dev Size: [".$BIOS_Dev_Size."]\n");
	    }

	    if($Line =~/^Name:/)
	    {
		my $Name = $Line;
		$Name =~s/^Name: \[//;
		$Name =~s/\].*//;
		$Name =~s/\s//g;

		$Parts .= ':::' if($Parts);
		$Parts .= $Name;

		LOG("HDD_GFEL>       Name: [".$Name."]\n");
	    }
	    elsif($Line =~/^Type:/)
	    {
		my $Type = $Line;
		$Type =~s/^Type: \[//;
		$Type =~s/\].*//;
		$Type =~s/\s//g;

		$Types .= ':::' if($Types);
		$Types .= $Type;

		LOG("HDD_GFEL>       Type: [".$Type."]\n");
	    }
	    elsif($Line =~/^FS_Type:/)
	    {
		my $FS_Type = $Line;
		$FS_Type =~s/^FS_Type: \[//;
		$FS_Type =~s/\].*//;
		$FS_Type =~s/\s//g;

		$FS_Types .= ':::' if($FS_Types);
		$FS_Types .= $FS_Type;

		LOG("HDD_GFEL>       FS_Type: [".$FS_Type."]\n");
	    }
	    elsif($Line =~/^Dirs:/)
	    {
		my $Dir_s = $Line;
		$Dir_s =~s/^Dirs: \[//;
		$Dir_s =~s/\].*//;

		$Dirs .= ':::' if($Dirs);
		$Dirs .= $Dir_s;

		LOG("HDD_GFEL>       Dirs: [".$Dir_s."]\n");
	    }
	    elsif($Line =~/^Label:/)
	    {
		my $Label = $Line;
		$Label =~s/^Label: \[//;
		$Label =~s/\].*//;
		$Label =~s/\s//g;

		$Labels .= ':::' if($Labels);
		$Labels .= $Label;

		LOG("HDD_GFEL>       Label: [".$Label."]\n");
	    }
	    elsif($Line =~/^Boot flag:/)
	    {
		my $Boot_Flag = $Line;
		$Boot_Flag =~s/^Boot flag: \[//;
		$Boot_Flag =~s/\].*//;
		$Boot_Flag =~s/\s//g;

		$Boot_Flags .= ':::' if($Boot_Flags);
		$Boot_Flags .= $Boot_Flag;

		LOG("HDD_GFEL>       Boot flag: [".$Boot_Flag."]\n");
	    }
	    elsif($Line =~/^Start:/)
	    {
		my $Star_t = $Line;
		$Star_t =~s/^Start: \[//;
		$Star_t =~s/\].*//;
		$Star_t =~s/\s//g;

		$Start .= ':::' if($Start);
		$Start .= $Star_t;

		LOG("HDD_GFEL>       Start: [".$Star_t."]\n");
	    }
	    elsif($Line =~/^End:/)
	    {
		my $En_d = $Line;
		$En_d =~s/^End: \[//;
		$En_d =~s/\].*//;
		$En_d =~s/\s//g;

		$End .= ':::' if($End);
		$End .= $En_d;

		LOG("HDD_GFEL>       End: [".$En_d."]\n");
	    }
	    # Keep this for backward PING compatibility...
	    # fdisk switched from blocks to sectors; we follow the idea;
	    # prior PING-made images should not be KO for this matter.
	    #
	    elsif($Line =~/^Blocks:/)
	    {
		my $Block_s = $Line;
		$Block_s =~s/^Blocks: \[//;
		$Block_s =~s/\].*//;
		$Block_s =~s/\s//g;

		# Ex.: blockdev --getsize64 /dev/sdb1   = 64423460864 bytes
		#      blockdev --getsz /dev/sdb1       = 125827072   sectors (of 512 bytes)
		#      blockdev --getbsz /dev/sdb       = 4096        is the block size in bytes
		#      So, there are 64423460864 / 4096 = 15728384    blocks
		#
		$Sectors .= ':::' if($Sectors);
		$Sectors .= int($Block_s * $BIOS_Block_Size / $BIOS_Sector_Size);

		LOG("HDD_GFEL>       Sectors: [".$Block_s."]\n");
	    }
	    elsif($Line =~/^Sectors:/)
	    {
		my $Sector_s = $Line;
		$Sector_s =~s/^Sectors: \[//;
		$Sector_s =~s/\].*//;
		$Sector_s =~s/\s//g;

		$Sectors .= ':::' if($Sectors);
		$Sectors .= $Sector_s;

		LOG("HDD_GFEL>       Sectors: [".$Sector_s."]\n");
	    }
	    elsif($Line =~/^Size:/)
	    {
		my $Siz_e = $Line;
		$Siz_e =~s/^Size: \[//;
		$Siz_e =~s/\].*//;
		$Siz_e =~s/\s//g;

		$Size .= ':::' if($Size);
		$Size .= $Siz_e;

		LOG("HDD_GFEL>       Size: [".$Siz_e."]\n");
	    }
	    elsif($Line =~/^Used_Space:/)
	    {
		my $U = $Line;
		$U =~s/^Used_Space: \[//;
		$U =~s/\].*//;
		$U =~s/\s//g;

		$Used_Space .= ':::' if($Used_Space);
		$Used_Space .= $U;

		LOG("HDD_GFEL>       Used_Space: [".$U."]\n");
	    }
	}
    }
    close(D);

    # We couldn't use references any more because of the loop parsing.
    # Therefore, no use of arrays before, as references would overwrite values.
    # Time to clean up.
    #
    my(@New_D) = ();
    foreach my $D (@{ $pD })
    {	
	my(%Rich) = ();

	$Rich{Dev} = $D->{Dev};
	$Rich{Heads} = $D->{Dev_Heads};
	$Rich{Sectors_Track} = $D->{Dev_Sectors_Track};
	$Rich{Cylinders} = $D->{Dev_Cylinders};
	$Rich{BIOS_Heads} = $D->{BIOS_Heads};
	$Rich{BIOS_Sectors_Track} = $D->{BIOS_Sectors_Track};
	$Rich{BIOS_Cylinders} = $D->{BIOS_Cylinders};
	$Rich{BIOS_Sector_Size} = $D->{BIOS_Sector_Size};
	$Rich{BIOS_Block_Size} = $D->{BIOS_Block_Size};
	$Rich{BIOS_Dev_Size} = $D->{BIOS_Dev_Size};

	my(@Parts) = split(/:::/, $D->{Parts});
	$Rich{Parts} = \@Parts;

	my(@Types) = split(/:::/, $D->{Types});
	$Rich{Types} = \@Types;

	my(@FS_Types) = split(/:::/, $D->{FS_Types});
	$Rich{FS_Types} = \@FS_Types;

	my(@Dirs) = split(/:::/, $D->{Dirs});
	$Rich{Dirs} = \@Dirs;

	my(@Labels) = split(/:::/, $D->{Labels});
	$Rich{Labels} = \@Labels;

	my(@Boot_Flags) = split(/:::/, $D->{Boot_Flags});
	$Rich{Boot_Flags} = \@Boot_Flags;

	my(@Start) = split(/:::/, $D->{Start});
	$Rich{Start} = \@Start;

	my(@End) = split(/:::/, $D->{End});
	$Rich{End} = \@End;

	my(@Blocks) = split(/:::/, $D->{Blocks});
	$Rich{Blocks} = \@Blocks;

	my(@Sectors) = split(/:::/, $D->{Sectors});
	$Rich{Sectors} = \@Sectors;

	my(@Size) = split(/:::/, $D->{Size});
	$Rich{Size} = \@Size;

	my(@Used_Space) = split(/:::/, $D->{Used_Space});
	$Rich{Used_Space} = \@Used_Space;

	push(@New_D, \%Rich);
    }
    @{ $pD } = @New_D;
}



# Tells wether a device exists or not on the current system.
# Ex.: if(Does_Dev_Exist("hda", \@Dev_Rich)) ...
# Ex.: if(Does_Dev_Exist("hda1", \@Dev_Rich)) ...
# Ex.: if(Does_Dev_Exist("hda", \@Dev_Rich)) ...
# Ex.: if(Does_Dev_Exist("rd/c0d0p1", \@Dev_Rich)) ...
# Ex.: if(Does_Dev_Exist("rd/c0d0", \@Dev_Rich)) ...
# Ex.: if(Does_Dev_Exist("mapper/VolGroup00-LogVol00", \@Dev_Rich)) ...
# Ex.: if(Does_Dev_Exist("md126p1", \@Dev_Rich)) ...
#
sub Does_Dev_Exist
{
    my $To_Check = shift || '';
    my $pD = shift || '';
    return(0) unless($To_Check && $pD);

    $To_Check =~s/^\/dev\/?//;

    foreach my $D (@{ $pD })
    {
	if($D->{Dev} eq $To_Check)
	{
	    return(1);
	}

	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    if($D->{Parts}->[$i] eq $To_Check)
	    {
		return(1);
	    }
	}
    }

    return(0);
}



# ChkDev / Check device existence in /dev
#
# All conventional /dev files are enumerated here:
# http://www.lanana.org/docs/device-list/devices.txt (2005 doc!)
#
sub ChkDev
{
    my $Part = shift || '';
    return(0) unless($Part);

    $Part =~s/^\/dev\/?//;

    LOG("ChkDev> Will check the existence of [/dev/".$Part."]\n");

    if(-e "/dev/".$Part)
    {
	LOG("ChkDev> Is ok.\n");
	return(1);
    }
    else
    {
	LOG("ChkDev> Should be there, or should be created. Udev did not...\n");
	return(0);
    }
}



# ADT / Adjust Device Target
#
# Sometimes, you store an image called after device /dev/hda,
# and you want to restore it to a SATA-enabled system => /dev/sda.
# Ex.: ADT("hda", \@Dev_Rich) => may return "sda"
#      ADT("hda1", \@Dev_Rich) => may return "cciss/c0d0p1"
#      ADT("askme_a1", \@Dev_Rich) => may return "sda1"
#      ADT("mapper/VolGroup00-LogVol00", \@Dev_Rich) => may return "sda1"
#
sub ADT
{
    my $To_Check = shift || '';
    my $pD = shift || '';
    return($To_Check) unless($To_Check && $pD);

    $To_Check =~s/^\/dev\/?//;

    LOG("ADT> Check for [".$To_Check."]\n");

    # Find the device after the thing to check.
    #
    my $Device_To_Check = HDD_Name($To_Check);   # => hda or cciss/c0d0
    my $Part_To_Check = Part_Number($To_Check);  # => \d+ or nothing

    LOG("ADT>   Device to check: [".$Device_To_Check."]\n");
    LOG("ADT>   Part to check: [".$Part_To_Check."]\n");

    # If the device exists, leave...
    #
    if(Does_Dev_Exist($Device_To_Check, $pD))
    {
	LOG("ADT> The device [".$Device_To_Check."] exists\n");
	LOG("ADT> Return [".$To_Check."] (1)\n");
	return($To_Check);
    }

    # If we've already asked for the target of this device/part,
    # send it back.
    #
    if(defined($Target_Device{$Device_To_Check}))
    {
	LOG("ADT> Found target device: [".$Target_Device{$Device_To_Check}."] (2)\n");

	LOG("ADT>   To check: [".$To_Check."]\n");
	my $Defined = $To_Check;
	$Defined =~s/$Device_To_Check/$Target_Device{$Device_To_Check}/;
	$Defined =~s/\-LogVol\d*//g;
	LOG("ADT>   Defined: [".$Defined."]\n");

	if($To_Check =~/mapper\/VolGroup\d+/)
	{
	    if($Defined =~/mapper\/VolGroup\d+/)
	    {
		$Defined .= "-LogVol".Part_Number($To_Check);
	    }
	    elsif($Defined =~/(cciss|rd|ida|mapper|md)/)
	    {
		$Defined .= "p".(int(Part_Number($To_Check)) + 1);
	    }
	    else
	    {
		$Defined .= (int(Part_Number($To_Check)) + 1);
	    }
	}
	else
	{
	    if($Defined =~/mapper\/VolGroup\d+/)
	    {
		$Defined .= "-LogVol0".(int(Part_Number($To_Check)) - 1);
		$Defined =~s/LogVol00/LogVol0/;
	    }
	    elsif($Defined =~/(cciss|rd|ida|mapper|md)/)
	    {
		$Defined .= "p".Part_Number($To_Check);
	    }
	    else
	    {
		$Defined .= Part_Number($To_Check);
	    }
	}

	LOG("ADT> Return [".$Defined."] (2)\n");
	return($Defined);
    }

    # If not, we should ask... unless
    # 1. There's only one possible target device OR it's a LVM/RAID device
    # 2. And the user has passed a parameter to the kernel to prevent interactivity.
    #
    if($#Dev_Rich == 0
       && defined($P{Its_HDA_Stupid}) && YES($P{Its_HDA_Stupid}))
    {
	my $Defined = $Dev_Rich[0]->{Dev};
	if($To_Check =~/mapper\/VolGroup\d+/)
	{
	    if($Defined =~/mapper\/VolGroup\d+/)
	    {
		$Defined .= "-LogVol".Part_Number($To_Check);
	    }
	    elsif($Defined =~/(cciss|rd|ida|mapper|md)/)
	    {
		$Defined .= "p".(int(Part_Number($To_Check)) + 1);
	    }
	    else
	    {
		$Defined .= (int(Part_Number($To_Check)) + 1);
	    }
	}
	else
	{
	    if($Defined =~/mapper\/VolGroup\d+/)
	    {
		$Defined .= "-LogVol0".(int(Part_Number($To_Check)) - 1);
		$Defined =~s/LogVol00/LogVol0/;
	    }
	    elsif($Defined =~/(cciss|rd|ida|mapper|md)/)
	    {
		$Defined .= "p".Part_Number($To_Check);
	    }
	    else
	    {
		$Defined .= Part_Number($To_Check);
	    }
	}

	LOG("ADT> Return [".$Defined."] (3)\n");
	$Target_Device{$Device_To_Check} = $Dev_Rich[0]->{Dev};
	return($Defined);
    }

    if($To_Check =~/(cciss|rd|ida|mapper|md)/
       && defined($P{Its_HDA_Stupid}) && YES($P{Its_HDA_Stupid}))
    {
	LOG("ADT> Return [".$To_Check."] (3)\n");
	return($To_Check);
    }

    # Now, ask.
    #
    LOG("ADT> Ask what target device to use\n");

    my $cmd = 'dialog --colors --menu "\Zb\ZnThe device that has been'
	.' recorded initially is /dev/'.$Device_To_Check.' but it cannot'
	.' be found in your system. Maybe you would want us to apply'
	.' this image to one of the devices found on your system ?'
	.' For info, on your HDD...\n\n';

    foreach my $D (@Dev_Rich)
    {
	$cmd .= 'Device '.$D->{Dev}.' has '.($#{ $D->{Parts} } + 1).' part'
	    .($#{ $D->{Parts} } > 0 ? 's':'').'; ';

	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    $cmd .= $D->{Parts}->[$i].' => '
		.($D->{Dirs}->[$i] ? substr($D->{Dirs}->[$i], 0, 50):'unknown')
		.(length($D->{Dirs}->[$i]) > 50 ? '...':'').'; ';
	}

	$cmd =~s/; $//;
	$cmd .= ')\n';
    }

    $cmd .= '\n\n" 20 73 5 "Cancel the process" "" ';

    # Sometimes, saved files refer to LVM or RAID volumes, and
    # they will appear on the target box only after first devices
    # have been restored (sda before mapper/VolGroup00). Give the
    # possibility not to map now.
    #
    if($To_Check =~/(cciss|rd|ida|mapper|md)/)
    {
	$cmd .= '"There is a RAID or LVM, it will appear, dont map!" "" ';
    }

    foreach my $D (@Dev_Rich)
    {
	$cmd .= '"'.$D->{Dev}.'" "" ';
    }
    $cmd .= ' 2>'.$TMPDIR.'/checklist.tmp';
    system($cmd);

    if(-z $TMPDIR."/checklist.tmp")
    {
	Quit();
    }

    my $Choice = '';
    open(DB, $TMPDIR."/checklist.tmp");
    while(<DB>)
    {
	$Choice .= $_;
    }
    close(DB);
    unlink($TMPDIR."/checklist.tmp");

    $Choice =~s/^\s*//;
    $Choice =~s/\s+.*$//;
    LOG("ADT> Choice: [".$Choice."]\n");

    if($Choice =~/cancel/i)
    {
	Quit();
    }

    if($Choice =~/there/i)
    {
	LOG("ADT> Part of a RAID/LVM to be built. Don't map now.\n");
	LOG("ADT> Return [".$To_Check."] (5)\n");
	$Target_Device{$Device_To_Check} = $To_Check;
	return($To_Check);
    }

    my $Defined = $Choice;
    if($To_Check =~/mapper\/VolGroup\d+/)
    {
	if($Defined =~/mapper\/VolGroup\d+/)
	{
	    $Defined .= "-LogVol".Part_Number($To_Check);
	}
	elsif($Defined =~/(cciss|rd|ida|mapper|md)/)
	{
	    $Defined .= "p".(int(Part_Number($To_Check)) + 1);
	}
	else
	{
	    $Defined .= (int(Part_Number($To_Check)) + 1);
	}
    }
    else
    {
	if($Defined =~/mapper\/VolGroup\d+/)
	{
	    $Defined .= "-LogVol0".(int(Part_Number($To_Check)) - 1);
	    $Defined =~s/LogVol00/LogVol0/;
	}
	elsif($Defined =~/(cciss|rd|ida|mapper|md)/)
	{
	    $Defined .= "p".Part_Number($To_Check);
	}
	else
	{
	    $Defined .= Part_Number($To_Check);
	}
    }

    LOG("ADT> Return [".$Defined."] (4)\n");
    $Target_Device{$Device_To_Check} = $Choice;
    return($Defined);
}



# Formats the filesystem of a partition.
# If FAT, will only format FAT32.
# If EXT, will only format EXT3.
#
# Ex.: Format("hda1", \@Dev_Rich);
# Ex.: Format("/dev/rd/c0d0p1", \@Dev_Rich);
#
# Ex.: Format("hda1", "ntfs");
# Ex.: Format("sdb1", "ext4");
#
sub Format
{
    my $Part = shift || '';
    my $pD = shift || '';
    return(0) unless($Part && $pD);

    $Part =~s/^\/dev\/?//;

    LOG("Format> Will format [/dev/".$Part."]\n");

    my $ToType = "";
    if($pD !~/^ARRAY/)
    {
	$ToType = $pD;
    }

    my(@cmd) = ();

    if($pD =~/^ARRAY/)
    {
	foreach my $D (@{ $pD })
	{
	    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	    {
		if($D->{Parts} eq $Part)
		{
		    LOG("Format> Partition known\n");
		    LOG("Format>   Partition type: [".$D->{Types}->[$i]."]\n");
		    LOG("Format>   FS type: [".$D->{FS_Types}->[$i]."]\n");

		    if(Is_NTFS($D->{Types}->[$i]) || $D->{FS_Types}->[$i] =~/ntfs/i)
		    {
			$ToType = "ntfs";
		    }
		    elsif($D->{FS_Types}->[$i] =~/^fat/i)
		    {
			$ToType = "fat";
		    }
		    elsif($D->{FS_Types}->[$i] =~/^ext(2|3)$/i)
		    {
			$ToType = "ext3";
		    }
		    elsif($D->{FS_Types}->[$i] =~/^ext4$/i)
		    {
			$ToType = "ext4";
		    }
		}
	    }
	}
    }

    if($ToType eq "ntfs")
    {
	$cmd[0] = "mkntfs -Q";
    }
    elsif($ToType eq "ext3")
    {
	$cmd[0] = "mkfs.ext3";
    }
    elsif($ToType eq "ext4")
    {
	# Now mkfs.ext4 is available.
	#$cmd[0] = "mkfs.ext3";
	#$cmd[1] = "tune2fs -O extents,uninit_bg,dir_index";
	#$cmd[2] = "e2fsck -fDC0y";
	$cmd[0] = "mkfs.ext4";
    }
    elsif($ToType eq "fat")
    {
	$cmd[0] = "mkfs.vfat -F 32";
    }

    if($cmd[0])
    {
	foreach(@cmd)
	{
	    $_ .= " /dev/".$Part;
	    Exec_Log($_, 0, "Format>   ");
	}
    }
    else
    {
	LOG("Format>   Don't know how to format this FS.\n");
    }
}



# Delete all partitions of a device.
# Ex.: Delete_All_Parts("hda", \@Dev_Rich);
#
sub Delete_All_Parts
{
    my $DEVICE = shift || '';
    my $pD = shift;

    $DEVICE =~s/^\/dev\///;

    LOG("Delete_All_Parts> * Suppressing all parts from device [".$DEVICE."]\n");

    # Well, PING is not going to touch the source it is to
    # get the images from !
    #
    if($SRC =~/dos/
       && ((Is_Mounted("/mnt/dos")
	    && HDD_Name(Dev_Mount_Point("/mnt/dos")) eq $DEVICE)
	   || ($Part_For_Storage
	       && HDD_Name($Part_For_Storage) eq $DEVICE)))
    {
	LOG("Delete_All_Parts>   Won't touch HDD [".$DEVICE."] because\n");
	LOG("Delete_All_Parts>     it contains the image to restore!\n");
	sleep($README_SLEEP);
	return();
    }

    # Empty segments must be removed
    #
    my(@New_D) = ();

    foreach my $D (@{ $pD })
    {
	if(! $D->{Dev} eq $DEVICE)
	{
	    push(@New_D, $D);
	}
	else
	{
	    my(@Parts) = ();
	    my(@Types) = ();
	    my(@FS_Types) = ();
	    my(@Dirs) = ();
	    my(@Labels) = ();
	    my(@Boot_Flags) = ();
	    my(@Start) = ();
	    my(@End) = ();
	    my(@Blocks) = ();
	    my(@Sectors) = ();
	    my(@Size) = ();
	    my(@Used_Space) = ();

	    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	    {
		if($D->{Parts}->[$i] ne 'null'
		   && $D->{Parts}->[$i] !~/(cciss|ida|rd|mapper|md)/i)
		{
		    push(@Parts, $D->{Parts}->[$i]);
		    push(@Types, $D->{Types}->[$i]);
		    push(@FS_Types, $D->{FS_Types}->[$i]);
		    push(@Dirs, $D->{Dirs}->[$i]);
		    push(@Labels, $D->{Labels}->[$i]);
		    push(@Boot_Flags, $D->{Boot_Flags}->[$i]);
		    push(@Start, $D->{Start}->[$i]);
		    push(@End, $D->{End}->[$i]);
		    push(@Blocks, $D->{Blocks}->[$i]);
		    push(@Sectors, $D->{Sectors}->[$i]);
		    push(@Size, $D->{Size}->[$i]);
		    push(@Used_Space, $D->{Used_Space}->[$i]);
		}
	    }

	    my(%Rich) = ();
	    $Rich{Dev} = $D->{Dev};
	    $Rich{Heads} = $D->{Heads};
	    $Rich{Sectors_Track} = $D->{Sectors_Track};
	    $Rich{Cylinders} = $D->{Cylinders};
	    $Rich{BIOS_Heads} = $D->{BIOS_Heads};
	    $Rich{BIOS_Sectors_Track} = $D->{BIOS_Sectors_Track};
	    $Rich{BIOS_Cylinders} = $D->{BIOS_Cylinders};
	    $Rich{BIOS_Sector_Size} = $D->{BIOS_Sector_Size};
	    $Rich{BIOS_Block_Size} = $D->{BIOS_Block_Size};
	    $Rich{BIOS_Dev_Size} = $D->{BIOS_Dev_Size};
	    $Rich{Parts} = \@Parts;
	    $Rich{Types} = \@Types;
	    $Rich{FS_Types} = \@FS_Types;
	    $Rich{Dirs} = \@Dirs;
	    $Rich{Labels} = \@Labels;
	    $Rich{Boot_Flags} = \@Boot_Flags;
	    $Rich{Start} = \@Start;
	    $Rich{End} = \@End;
	    $Rich{Blocks} = \@Blocks;
	    $Rich{Sectors} = \@Sectors;
	    $Rich{Size} = \@Size;
	    $Rich{Used_Space} = \@Used_Space;

	    push(@New_D, \%Rich);
	}
    }

    # Suppresssing all parts from the device $DEVICE.
    # When an extended partition is deleted, the contained parts
    # are automatically deleted at the same time.
    #
    foreach my $D (@New_D)
    {
	LOG("Delete_All_Parts>   Device [".$D->{Dev}."]\n");

	if($D->{Dev} eq $DEVICE)
	{
	    my $Last_Type = '';
	    my(@tmp) = ('p');
	    if($#{ $D->{Parts} } == -1)
	    {
		LOG("Delete_All_Parts>     No partition to delete.\n");
	    }
	    elsif($#{ $D->{Parts} } == 0)
	    {
		LOG("Delete_All_Parts>     Only one partition to delete.\n");
		push(@tmp, 'd');
	    }
	    else
	    {
		my(@Del_Start) = ();
		my(@Del_End) = ();
		for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
		{
		    if($D->{Parts}->[$i] eq 'null')
		    {
			next;
		    }

		    # Not going to recreate these parts with fdisk !
		    #
		    if($D->{Parts}->[$i] =~/(cciss|ida|rd|mapper|md)/i)
		    {
			next;
		    }

		    my $flag = 0;
		    for(my $j = 0; $j <= $#Del_Start; $j++)
		    {
			if($D->{Start}->[$i] >= $Del_Start[$j]
			   && $D->{End}->[$i] <= $Del_End[$j])
			{
			    ++ $flag;
			    last;
			}
		    }
		    unless($flag)
		    {
			push(@tmp, 'd', Part_Number($D->{Parts}->[$i]));
			push(@Del_Start, $D->{Start}->[$i]);
			push(@Del_End, $D->{End}->[$i]);
			$Last_Type = $D->{Types}->[$i];
		    }
		}
	    }
	    if($#tmp > -1)
	    {
		# When there's only one partition remaining, fdisk does
		# not need the digit to be precised. So, we should remove
		# it. But, if the last part we wanted to remove was an
		# extended one, there can be other parts afterwards, and
		# then the digit should be written.
		#
		if(! Is_Part_Extended($Last_Type) && $tmp[-1] =~/^\d+$/)
		{
		    pop(@tmp);
		}
		push(@tmp, 'p');
		push(@tmp, 'w');
		my $cmd = 'echo -e "';
		foreach(@tmp)
		{
		    $cmd .= $_.'\n';
		}
		$cmd .= '" | fdisk /dev/'.$D->{Dev}.' 2>&1';
		LOG("Delete_All_Parts>     Cmd: [".$cmd."]\n");
		my $out = `$cmd`;
		$out =~s/^\s*//;
		$out =~s/\s*$//;
		LOG("Delete_All_Parts>     Output: [".$out."]\n");

		# Finally, if all partitions have been deleted, fdisk
		# now returns the number of heads/sectors by track/cylinders
		# by getting it from the kernel (= BIOS), and this can differ
		# from what it was before. We've got to re-set these settings
		# as they were. (Only possible on IDE devices. Not SCSI/SATA.)
		#
		if($D->{Heads} ne $D->{BIOS_Heads}
		   || $D->{Sectors_Track} ne $D->{BIOS_Sectors_Track}
		   || $D->{Cylinders} ne $D->{BIOS_Cylinders})
		{
		    LOG("Delete_All_Parts>     P.Table device geometry differs"
			." from BIOS's.\n");
		    if(-e "/proc/ide/".$DEVICE."/settings")
		    {
			LOG("Delete_All_Parts>       It's a IDE drive. Rectifying.\n");
			my $cmd = "echo bios_cyl:".$D->{Cylinders}
			." bios_head:".$D->{Heads}
			." bios_sect:".$D->{Sectors_Track}
			." >/proc/ide/".$DEVICE."/settings";
			LOG("Delete_All_Parts>       Cmd: [".$cmd."]\n");
			my $out = `$cmd 2>&1`;
			$out =~s/^\s*//;
			$out =~s/\s*$//;
			LOG("Delete_All_Parts>       Output: [".$out."]\n");
			LOG("Delete_All_Parts>       Synchronizing device [".$DEVICE."]\n");
			Synchronize_Device($DEVICE);
		    }
		    else
		    {
			LOG("Delete_All_Parts>       It's not a IDE drive."
			    ." Odd!! No action.\n");
		    }
		}
		else
		{
		    LOG("Delete_All_Parts>     P.Table device geometry is same"
			." as BIOS's.\n");
		}
	    }
	}
	else
	{
	    LOG("Delete_All_Parts>     Not [".$DEVICE."].\n");
	}
    }
}



# Kill a process after its name.
#
sub KILL
{
    my $Proc = shift || '';
    return unless($Proc);

    my $out = `ps -ef|grep "$Proc"|grep -v grep|grep -v "$MYSELF"`;
    my(@lines) = split(/\n/, $out);
    #LOG("PPID() Out: [$out]\n");

    my(@PIDs) = ();
    foreach my $L (@lines)
    {
	my @f = split(/ +/, $L);
	if(defined($f[1]))
	{
	    $f[1] =~s/^\s*//;
	    $f[1] =~s/\s*$//;
	    push(@PIDs, $f[1]);
	}
    }

    foreach(@PIDs)
    {
	system("kill -9 ".$_);
    }
}



# Re-create all partitions of a device.
# Ex.: Recreate_All_Parts("hda", \@Dev_Rich);
#
sub Recreate_All_Parts
{
    my $DEVICE = shift || '';
    my $pD = shift;

    $DEVICE =~s/^\/dev\///;

    LOG("Recreate_All_Parts> * Re-creating all parts of device [".$DEVICE."]\n");

    # Well, PING is not going to touch the source it is to
    # get the images from !
    #
    if($SRC =~/dos/
       && ((Is_Mounted("/mnt/dos")
	    && HDD_Name(Dev_Mount_Point("/mnt/dos")) eq $DEVICE)
	   || ($Part_For_Storage
	       && HDD_Name($Part_For_Storage) eq $DEVICE)))
    {
	LOG("Recreate_All_Parts>   Won't touch HDD [".$DEVICE."] because\n");
	LOG("Recreate_All_Parts>     it contains the image to restore!\n");
	sleep($README_SLEEP);
	return();
    }

    foreach my $D (@{ $pD })
    {
	LOG("Recreate_All_Parts>   Device [".$D->{Dev}."]\n");

	if($D->{Dev} eq $DEVICE)
	{
	    my(@tmp) = ('p');
	    my $cnt = 0;
	    my $First_T = 0;

	    my $Nb_Not_Null_Parts = 0;
	    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	    {	
		if($D->{Parts}->[$i] eq 'null')
		{
		    next;
		}

		# Not going to recreate these parts with fdisk !
		#
		if($D->{Parts}->[$i] =~/(cciss|ida|rd|mapper|md)/i)
		{
		    next;
		}

		++ $Nb_Not_Null_Parts;
	    }

	    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	    {	
		if($D->{Parts}->[$i] eq 'null')
		{
		    next;
		}

		# Not going to recreate these parts with fdisk !
		#
		if($D->{Parts}->[$i] =~/(cciss|ida|rd|mapper|md)/i)
		{
		    next;
		}

		my $L_Flag = 0;
		push(@tmp, 'n');
		#
		# The choice between primary vs. extended/logical part
		# is not given by fdisk if the choice is irrelevant. Case:
		# 1 extended part has been created, + 3 primary =>l is assumed.
		#
		if(Is_Part_Extended($D->{Types}->[$i]))
		{
		    push(@tmp, 'e');
		    ++ $cnt;
		}
		else
		{
		    if(Part_Number($D->{Parts}->[$i]) > 4)
		    {
			if($cnt < 4)
			{
			    push(@tmp, 'l');
			}
			++ $L_Flag;
		    }
		    else
		    {
			push(@tmp, 'p');
			++ $cnt;
		    }
		}
		#
		# Logical part's number is never asked.
		# Primary part's number is not asked when it's the last available
		# (means 2 primary parts and 1 ext'd part, or 3 primary parts, have
		# already been created).
		#
		unless($L_Flag || $cnt == 4)
		{
		    push(@tmp, Part_Number($D->{Parts}->[$i]));
		}
		push(@tmp, $D->{Start}->[$i]);
		push(@tmp, $D->{End}->[$i]);
		push(@tmp, 't');
		if($First_T)
		{
		    push(@tmp, Part_Number($D->{Parts}->[$i]));
		}
		else
		{
		    ++ $First_T;
		}
		push(@tmp, $D->{Types}->[$i]);
		if($D->{Boot_Flags}->[$i])
		{
		    push(@tmp, 'a');
		    #
		    # For boot flag, always need to tell which part,
		    # even if there's only one.
		    #
		    push(@tmp, Part_Number($D->{Parts}->[$i]));
		}
	    }
	    push(@tmp, 'p');
	    push(@tmp, 'w');
	    my $cmd = 'echo -e "';
	    foreach(@tmp)
	    {
		$cmd .= $_.'\n';
	    }
	    $cmd .= '" | fdisk /dev/'.$D->{Dev}.' 2>&1';
	    LOG("Recreate_All_Parts>     Cmd: [".$cmd."]\n");
	    my $out = `$cmd 2>&1`;
	    $out =~s/^\s*//;
	    $out =~s/\s*$//;
	    LOG("Recreate_All_Parts>     Output: [".$out."]\n");
	}
	else
	{
	    LOG("Recreate_All_Parts>     Not [".$DEVICE."].\n");
	}
    }
}



# Ex.: Build_Fakeraids();
#
sub Build_Fakeraids
{
    my($pRAID_Members) = shift;   # Pointer

    LOG("Build_Fakeraids> * Build fakeraid /dev/md* devices, if any\n");

    # If we've already launched PING once, then udev (see below)
    # is already purged from RAID member devices. So, we won't be able
    # to detect them twice. Thus, have the RAID members written for
    # once in a file.
    #
    if(-e $TMPDIR."/RAID_Members")
    {
        LOG("Build_Fakeraids>   Already detected before.\n");
        open(DB, $TMPDIR."/RAID_Members");
        while(<DB>)
        {
            s/^\s*//;
            s/\s*$//;
            push(@{ $pRAID_Members }, $_);
        }
        close(DB);
	LOG("Build_Fakeraids>     Found in the [".$TMPDIR."/RAID_Members] file:\n");
	foreach(@{ $pRAID_Members })
	{
	    LOG("Build_Fakeraids>       [".$_."]\n");
	}
    }
    else
    {
        LOG("Build_Fakeraids>   Not detected before. Do so now.\n");

        # If we succeed in building a fakeraid, then the members,
        # such as sda1, sdb1, etc. will be busy. The kernel won't
        # allow addressing them directly, and therefore, udev will
        # remove them from the /dev nodes. We must check what nodes
        # will be removed.
        #
        opendir(DIR, "/dev");
        my(@Dev1) = readdir(DIR);
        closedir(DIR);

        # Now try to addemble the fakeraid
        #
        my $cmd = "mdadm --assemble --scan 2>&1";
        LOG("Build_Fakeraids>   Cmd: [".$cmd."]\n");
        my $out = `$cmd`;
        $out =~s/^\s*//;
        $out =~s/\s*$//;
        LOG("Build_Fakeraids>   Out: [".$out."]\n");

        # If the output contains something like 'Started', it worked out.
        # There's a special case: an intel fakeRAID exists in the BIOS,
        # but is disabled. Then, the command will end with:
        #   ERROR: isw: wrong number of devices in RAID set "isw_chichjddje_Volume0" [1/2] on /dev/sda
        #   RAID set "isw_chichjddje_Volume0" was not activated
        #   ERROR: device "isw_chichjddje_Volume0" could not be found]
        # In that case, the mdadm command still tries to manage
        # the /dev/md* devices, thus making standard /dev/sda*
        # partitions busy. We must therefore catch the error, and
        # release all fakeraid devices.
        #
        if($out =~/ERROR/ && $out =~/not\s*activated/i)
        {
            LOG("Build_Fakeraids>   Error caught! the fakeraid is disabled. Release everything!\n");

	    opendir(DIR, "/dev");
	    my(@files) = readdir(DIR);
	    closedir(DIR);

	    foreach(@files)
	    {
	        if(m/^md/)
	        {
	            $cmd = "mdadm --manage -S /dev/".$_;
		    Exec_Log($cmd, 4, "Build_Fakeraids> ");
	        }
	    }
        }
        else
        {
	    LOG("Build_Fakeraids>   Success.\n");

	    # Time to fetch what devices have disappeared
	    #
	    opendir(DIR, "/dev");
	    my(@Dev2) = readdir(DIR);
	    closedir(DIR);

	    for(my $i = 1; $i <= $#Dev1; $i++)
	    {
	        my $flag = 0;
	        for(my $j = 0; $j <= $#Dev2; $j++)
	        {
	  	    if($Dev2[$j] eq $Dev1[$i])
		    {
		        ++ $flag;
		        last;
		    }
	        }
	        unless($flag)
	        {
		    push(@{ $pRAID_Members }, $Dev1[$i]);
	        }
	    }
	    foreach(@{ $pRAID_Members })
	    {
	        LOG("Build_Fakeraids>   RAID Member: [".$_."]\n");
	    }

            # If we've fetched people, log them in the tmp file.
            #
            if($#{ $pRAID_Members } > -1)
            {
                LOG("Build_Fakeraids>   Write the members in [".$TMPDIR."/RAID_Members]\n");
                open(DB, ">".$TMPDIR."/RAID_Members");
                foreach(@{ $pRAID_Members })
                {
                    print DB $_."\n";
                }
                close(DB);
            }
        }
    }

    LOG("Build_Fakeraids> * End\n");
}



# Simple execution of a command, with log.
#
sub Exec_Log
{
    my $cmd = shift;
    my $spaces = shift;
    my $prefix = shift;
    my $logit = shift;

    $cmd = '' unless(defined($cmd) && $cmd);
    $spaces = 0 unless(defined($spaces) && $spaces);
    $prefix = '' unless(defined($prefix) && $prefix);
    $logit = "nc" unless(defined($logit) && $logit);

    if($logit eq "nc")
    {
	if(defined($P{Verbosity}) && $P{Verbosity} == 0)
	{
	    $logit = 0;
	}
	else
	{
	    $logit = 1;
	}
    }
    if($logit)
    {
	$cmd = "(".$cmd.") 2>&1";
    }
    else
    {
	$cmd = "(".$cmd.") >/dev/null 2>&1";
    }
    LOG($prefix.(" "x$spaces)."Cmd: [".$cmd."]\n");
    if($logit)
    {
	my $out = '';
	$out = `$cmd` || '';
	$out =~s/^\s*//;
	$out =~s/\s*$//;
	LOG($prefix.(" "x$spaces)."Output: [".$out."]\n");
	return($out);
    }
    else
    {
	`$cmd`;
    }
}



# Discovering all HDD Devices and partitions.
#
# Syntax: HDD_Discover(\@Dev, \@Dev_Rich, \@RAID_Members);
#
sub HDD_Discover
{
    # Pointers
    my($pDev) = shift;
    my($pD) = shift;
    my($pRAID_Members) = shift;

    @{ $pD } = ();

    # Will have to handle fakeraid devices...
    # partitions may appear only after a dd.
    #
    {
	LOG("Disco> Preparing to handle possible fakeraid devices\n");
	Exec_Log("mdadm --assemble --scan", 2, "Disco> ");
    }

    # Will have to handle LVM devices...
    #
    {
	LOG("Disco> Preparing to handle possibly LVM devices\n");
	Exec_Log("vgscan; vgchange -ay; dmraid -ay", 2, "Disco> ");
    }

    foreach my $D (@{ $pDev })
    {
	LOG("Disco> Device [".$D."]\n");

	# Device geometry according to fdisk
	#
	my $Dev_Heads = 0;
	my $Dev_Sectors_Track = 0;
	my $Dev_Cylinders = 0;
	{
	    my $cmd = "sfdisk -g /dev/".$D." 2>&1";
	    LOG("Disco>   cmd: [".$cmd."]\n");
	    my $tmp = `$cmd`;
	    LOG("Disco>   out: [".$tmp."]\n");
	    $tmp =~s/^\s*//;
	    $tmp =~s/\s*$//;

	    if($tmp =~/(\d+)\s+cylinders/i)
	    {
		$Dev_Cylinders = $1;
		LOG("Disco>   Dev Cylinders: [".$Dev_Cylinders."]\n");
	    }
	    if($tmp =~/(\d+)\s+heads/i)
	    {
		$Dev_Heads = $1;
		LOG("Disco>   Dev Heads: [".$Dev_Heads."]\n");
	    }
	    if($tmp =~/(\d+)\s+sectors/i)
	    {
		$Dev_Sectors_Track = $1;
		LOG("Disco>   Dev Sectors Track: [".$Dev_Sectors_Track."]\n");
	    }
	}

	# Device geometry according to the kernel's reading
	# of BIOS data (and it can differ from real device
	# geometry). I store both data because people send their
	# log sometimes, and I'd like to know if someday, the
	# geometry given by the kernel becomes finally safe :)
	#
	my $BIOS_Heads = 0;
	my $BIOS_Sectors_Track = 0;
	my $BIOS_Cylinders = 0;
	my $BIOS_Sector_Size = 0;        # Usually 512 bytes. Might grow to 4192.
	my $BIOS_Block_Size = 0;
	my $BIOS_Dev_Size = 0;
	{
	    # Not possible anyway. sfdisk does not support -G anymore.
	    #
	    #my $cmd = "sfdisk -G /dev/".$D." 2>&1";
	    #LOG("Disco>   cmd: [".$cmd."]\n");
	    #my $tmp = `$cmd`;
	    #LOG("Disco>   out: [".$tmp."]\n");
	    #$tmp =~s/^\s*//;
	    #$tmp =~s/\s*$//;
	    #
	    #if($tmp =~/(\d+)\s+cylinders/i)
	    #{
	    #    $BIOS_Cylinders = $1;
	    #    LOG("Disco>   BIOS Cylinders: [".$BIOS_Cylinders."]\n");
	    #}
	    #if($tmp =~/(\d+)\s+heads/i)
	    #{
	    #    $BIOS_Heads = $1;
	    #    LOG("Disco>   BIOS Heads: [".$BIOS_Heads."]\n");
	    #}
	    #if($tmp =~/(\d+)\s+sectors/i)
	    #{
	    #    $BIOS_Sectors_Track = $1;
	    #    LOG("Disco>   BIOS Sectors Track: [".$BIOS_Sectors_Track."]\n");
	    #}
	    #

	    # Do it that way:
	    # echo |parted /dev/sdb1 print unit s print unit chs print|grep BIOS
	    # Output:
	    #   BIOS cylinder,head,sector geometry: 7832,255,63.  Each cylinder is 8225kB.
	    #
	    my $cmd = "echo |parted /dev/".$D." print unit s print unit chs print|grep BIOS 2>&1";
	    LOG("Disco>   cmd: [".$cmd."]\n");
	    my $out = `$cmd`;
	    LOG("Disco>   out: [".$out."]\n");
	    $out =~s/^\s*//;
	    $out =~s/\s*$//;
	    $out =~s/^.*\:\s+//;
	    $out =~s/\.\s+.*$//;
	    my(@fields) = split(/\,/, $out);
	    if($#fields == 2)
	    {
		$BIOS_Cylinders = $fields[0];
		$BIOS_Heads = $fields[1];
		$BIOS_Sectors_Track = $fields[2];
	    }
	    LOG("Disco>   BIOS Cylinders: [".$BIOS_Cylinders."]\n");
	    LOG("Disco>   BIOS Heads: [".$BIOS_Heads."]\n");
	    LOG("Disco>   BIOS Sectors Track: [".$BIOS_Sectors_Track."]\n");

	    $cmd = "echo |parted /dev/".$D." print unit s print unit chs print|grep Sector|head -n 1 2>&1";
	    LOG("Disco>   cmd: [".$cmd."]\n");
	    $out = `$cmd`;
	    LOG("Disco>   out: [".$out."]\n");
	    $out =~s/^\s*//;
	    $out =~s/\s*$//;
	    # Sector size (logical/physical): 512B/512B
	    if($out =~/^\D+(\d+)B\/(\d+)B$/)
	    {
		$BIOS_Sector_Size = $1;
	    }
	    else
	    {
		LOG("Disco>   Sector size could not be found. Defaulting to 512.\n");
		$BIOS_Sector_Size = 512;
	    }
	    LOG("Disco>   BIOS Sector Size: [".$BIOS_Sector_Size."]\n");

	    $BIOS_Dev_Size = $BIOS_Heads * $BIOS_Sectors_Track * $BIOS_Cylinders * $BIOS_Sector_Size;
	    LOG("Disco>   BIOS Dev Size: [".$BIOS_Dev_Size."]\n");

	    $cmd = "blockdev --getbsz /dev/".$D." 2>&1";
	    LOG("Disco>   cmd: [".$cmd."]\n");
	    $out = `$cmd`;
	    LOG("Disco>   out: [".$out."]\n");
	    $out =~s/^\s*//;
	    $out =~s/\s*$//;
	    if($out =~/^\d+$/)
	    {
		$BIOS_Block_Size = $out;
	    }
	    LOG("Disco>   BIOS Block Size: [".$BIOS_Block_Size."]\n");
	}

	my(@Parts) = ();
	my(@Types) = ();
	my(@FS_Types) = ();
	my(@Dirs) = ();
	my(@Labels) = ();
	my(@Boot_Flags) = ();
	my(@Start) = ();
	my(@End) = ();
	my(@Sectors) = ();
	my(@Size) = ();
	my(@Used_Space) = ();

	my $cmd = "fdisk -l /dev/".$D." >".$TMPDIR."/disco.$$ 2>&1";
	LOG("Disco>   cmd: [".$cmd."]\n");
	`$cmd`;

	if(-e $TMPDIR."/disco.$$")
	{
	    LOG("Disco>   out:\n");
	    open(DB, $TMPDIR."/disco.$$");
	    while(<DB>)
	    {
		s/\s*$//;
		LOG("Disco>     [".$_."]\n");
	    }
	    close(DB);

	    LOG("Disco>   Analyzing parts of device [".$D."]\n");

	    open(FD, $TMPDIR."/disco.$$");
	    while(my $line = <FD>)
	    {
		$line =~s/^\s*//;
		$line =~s/\s*$//;

		# Device     Boot   Start      End  Sectors  Size Id Type
		# /dev/sdb1          2048     4095     2048    1M 83 Linux
		# /dev/sdb2  *       4096   618495   614400  300M 83 Linux
		# /dev/sdb3        618496  4814847  4196352    2G 82 Linux swap / Solaris
		# /dev/sdb4       4814848 62914559 58099712 27.7G  5 Extended
		# /dev/sdb5       4816896 62914559 58097664 27.7G 83 Linux

		LOG("Disco>     Line [".$line."]\n");

		if($line =~/^\/dev\/$D/i)
		{
		    if($line =~/\*/)
		    {
			$line =~s/\*//g;    # Boot flag
			push(@Boot_Flags, 1);
		    }
		    else
		    {
			push(@Boot_Flags, 0);
		    }
		    $line =~s/  / /g while($line =~/  /);
		    $line =~s/^\s*\/dev\///i;
		    my(@F) = split(/ /, $line);
		    push(@Parts, $F[0]);

		    LOG("Disco>     Is part [".$F[0]."] a RAID member ?\n");
		    my $flag = 0;
		    foreach(@{ $pRAID_Members })
		    {
			if($F[0] eq $_)
			{
			    ++ $flag;
			    last;
			}
		    }
		    if($flag)
		    {
			LOG("Disco>       Yes! don't include the part in the discovery\n");
			pop(@Parts);
			pop(@Boot_Flags);
			next;
		    }
		    else
		    {
			LOG("Disco>       No. Good, go on with the discovery for that part\n");
		    }

		    for(1..3)
		    {
			$F[$_] =~s/\D//g;
		    }
		    push(@Start, $F[1]);
		    push(@End, $F[2]);
		    push(@Sectors, $F[3]);
		    push(@Types, $F[5]);
		    push(@Size, $F[3] * $BIOS_Sector_Size);
		    push(@Used_Space, Used_Space($F[0], 1));
		}
	    }
	    close(FD);
	    unlink($TMPDIR."/disco.$$");
	}

	LOG("Disco>   Parts found, so far:\n");
	if($#Parts >= 0)
	{
	    foreach(@Parts)
	    {
		LOG("Disco>   - [".$_."]\n");
	    }
	}
	else
	{
	    LOG("Disco>     None!\n");
	}

	# If LVM, add the volumes -- will be treated as parts.
	#
	# Warning, /dev/VolGroup00/LogVol00 should be transcribed to
	#   /dev/mapper/VolGroup00-LogVol00, as this is what df will show
	#   (function IsMounted() wouldn't see).
	#
	# New with Fedora 23: ok, the name of /dev/mapper/* files is arbitrary,
	# and doesn't have to be same as /dev/xxxx/yyyy.
	# Seen example:
	#   /dev/fedora_host-001/usr -> ../dm-5
	#   /dev/mapper/fedora_host--001/usr -> ../dm-5
	#
	# So, follow the symlink...
	#
	{
	    my $out = Exec_Log("lvscan", 2, "Disco> ");
	    my @L = split(/\n/, $out);
	    foreach my $L (@L)
	    {
		# [  ACTIVE       '/dev/VolGroup00/LogVol00' [15.34 GB] inherit]
		#
		$L =~s/^\s*//;
		if($L =~/^ACTIVE/)
		{
		    my $Part = $L;
		    $Part =~s/^[^\']+\'//;
		    $Part =~s/\'.*$//;
		    $Part =~s/^\/dev\///;

		    if(-l "/dev/".$Part)
		    {
			LOG("Disco>   [/dev/".$Part."] is a symlink...\n");
			my $link1 = abs_path("/dev/".$Part);
			LOG("Disco    Linked to: [".$link1."]\n");
			opendir(DIR, "/dev/mapper");
			my(@files) = readdir(DIR);
			closedir(DIR);
			foreach my $f (@files)
			{
			    next if($f =~/^\.{1,2}$/);
			    my $link2 = abs_path("/dev/mapper/".$f);
			    if($link1 eq $link2)
			    {
				LOG("Disco>   File [/dev/mapper/".$f."] is same\n");
				push(@Parts, "mapper/".$f);
				last;
			    }
			}
			LOG("Disco>   Found LVM: [/dev/".$Part."] =>[/dev/".$Parts[-1]."]\n");
		    }
		    else
		    {
			LOG("Disco>   ! Don't know what to do with [/dev/".$Part."]\n");
		    }

		    # I don't know how to retrieve the type of a logical volume,
		    # but I can at least detect if this is a linux swap.
		    #
		    LOG("Disco>   Is [/dev/".$Parts[-1]."] a linux swap ?\n");
		    if(Is_Swap("/dev/".$Parts[-1]))
		    {
			LOG("Disco>     It's a linux swap.\n");
			push(@Types, "82");
		    }
		    else
		    {
			LOG("Disco>     It's not.\n");
			push(@Types, '');
		    }

		    push(@Boot_Flags, 0);    # Never bootable

		    # To test, then todo
		    push(@Start, 0);
		    push(@End, 0);
		    push(@Sectors, 0);
		    push(@Types, '');
		    push(@Size, 0);
		    push(@Used_Space, 0);
		}
	    }
	}

	for(my $i = 0; $i <= $#Parts; $i++)
	{
	    LOG("Disco>   Local part: [".$Parts[$i]."]; type: [".$Types[$i]."]\n");

	    # Keep label (if ntfs)
	    #
	    if(Is_NTFS($Types[$i]))
	    {
		my $Label = `ntfslabel /dev/$Parts[$i]`;
		$Label =~s/^\s*//;
		$Label =~s/\s*$//;
		push(@Labels, $Label);
	    }
	    else
	    {
		push(@Labels, '');
	    }

	    # Keep first directory names, to help users identify their
	    # partitions (think USB mass storage). Get also filesystem type.
	    #
	    Umount("/mnt/dos");
	    Mount("/dev/".$Parts[$i], "/mnt/dos", "");

	    if(Is_Mounted("/dev/".$Parts[$i]))
	    {
		my $fst = FS_Type($Parts[$i]);
		push(@FS_Types, $fst);
		LOG("Disco>     Found FS type: [".$fst."]]\n");

		opendir(DIR, "/mnt/dos");
		my(@Files) = readdir(DIR);
		closedir(DIR);
		my(@R) = ();
		foreach(@Files)
		{
		    next if(m/^\.{1,2}$/);
		    next unless(-d "/mnt/dos/".$_);
		    next if(m/^System Volume Information$/i);   # Not an info
		    push(@R, $_);
		}
		push(@Dirs, join(',', @R));
		Exec_Log("umount /mnt/dos", 4, "Disco> ");

		LOG("Disco>     Found directories: [".join(', ', @R)."]\n");
	    }
	    else
	    {
		LOG("Disco>     No info about directories / FS type.\n");
		push(@Dirs, '');
		push(@FS_Types, '');
	    }
	}

	# Storage!
	#
	my(%Rich) = ();
	$Rich{Dev} = $D;
	$Rich{Heads} = $Dev_Heads;
	$Rich{Sectors_Track} = $Dev_Sectors_Track;
	$Rich{Cylinders} = $Dev_Cylinders;
	$Rich{BIOS_Heads} = $BIOS_Heads;
	$Rich{BIOS_Sectors_Track} = $BIOS_Sectors_Track;
	$Rich{BIOS_Cylinders} = $BIOS_Cylinders;
	$Rich{BIOS_Sector_Size} = $BIOS_Sector_Size;
	$Rich{BIOS_Block_Size} = $BIOS_Block_Size;
	$Rich{BIOS_Dev_Size} = $BIOS_Dev_Size;
	$Rich{Parts} = \@Parts;
	$Rich{Types} = \@Types;
	$Rich{FS_Types} = \@FS_Types;
	$Rich{Dirs} = \@Dirs;
	$Rich{Labels} = \@Labels;
	$Rich{Boot_Flags} = \@Boot_Flags;
	$Rich{Start} = \@Start;
	$Rich{End} = \@End;
	$Rich{Sectors} = \@Sectors;
	$Rich{Size} = \@Size;
	$Rich{Used_Space} = \@Used_Space;

	push(@{ $pD }, \%Rich);
    }

    # Now, handle the issue of possible unused segments. Complex.
    #
    # ! Now SECTORS, not Blocks any more !
    #
    # Ex.: Disk /dev/hda: 85.8 GB, 85899345920 bytes
    #      255 heads, 63 sectors/track, 10443 cylinders
    #      Units = cylinders of 16065 * 512 = 8225280 bytes
    #
    #         Device Boot      Start         End      Blocks   Id  System
    #      /dev/hda1               1           5       40131   de  Dell Utility
    #      /dev/hda2   *           6        9268    74405047+   7  HPFS/NTFS
    #      /dev/hda3            9290       10443     9269505   83  Linux
    #
    # Ex.: Disk /dev/hda: 85.8 GB, 85899345920 bytes
    #      255 heads, 63 sectors/track, 10443 cylinders
    #      Units = cylinders of 16065 * 512 = 8225280 bytes
    #
    #         Device Boot      Start         End      Blocks   Id  System
    #      /dev/hda1   *           1        1000     8032468+   7  HPFS/NTFS
    #      /dev/hda2            1001        8000    56227500    5  Extended
    #      /dev/hda3            8001        9000     8032500   83  Linux
    #      /dev/hda5            1001        3000    16064968+  83  Linux
    #      /dev/hda6            3001        7000    32129968+  83  Linux
    #
    LOG("Disco> * Handle the issue of empty segments\n");

    my(@New) = ();

    foreach my $D (@{ $pD })
    {
	LOG("Disco>   Device [".$D->{Dev}."]\n");

	my(@Parts) = ();
	my(@Types) = ();
	my(@FS_Types) = ();
	my(@Dirs) = ();
	my(@Labels) = ();
	my(@Boot_Flags) = ();
	my(@Start) = ();
	my(@End) = ();
	my(@Sectors) = ();
	my(@Size) = ();
	my(@Used_Space) = ();

	# No partitions in the device
	#
	if($#{ $D->{Parts} } < 0)
	{
	    LOG("Disco>     No partition. No problem.\n");
	    push(@New, $D);
	    next;
	}

	# Storage...
	#
	my(%Rich) = ();

	# Keep device general info
	#
	foreach('Dev', 'Heads', 'Sectors_Track', 'Cylinders',
		'BIOS_Heads', 'BIOS_Sectors_Track', 'BIOS_Cylinders',
		'BIOS_Sector_Size', 'BIOS_Block_Size', 'BIOS_Dev_Size')
	{
	    $Rich{$_} = $D->{$_};
	}

	# First, make sure at least one part starts at block 1.
	#
	LOG("Disco>     Check wether one part starts at block 1\n");

	my $First_Start = $D->{Cylinders};
	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    if($D->{Start}->[$i] < $First_Start)
	    {
		$First_Start = $D->{Start}->[$i];
	    }
	}
	LOG("Disco>       First start: [".$First_Start."]\n");

	if($First_Start > 1)
	{
	    LOG("Disco>       (1) Found null segment [1]-["
		.($First_Start - 1)."]\n");

	    push(@Parts, 'null');
	    push(@Types, 'null');
	    push(@FS_Types, 'null');
	    push(@Dirs, 'null');
	    push(@Labels, 'null');
	    push(@Boot_Flags, 'null');
	    push(@Start, 1);
	    push(@End, $First_Start - 1);
	    push(@Sectors, 'null');
	    push(@Size, 'null');
	    push(@Used_Space, 'null');
	}
	else
	{
	    LOG("Disco>       No null segment here\n");
	}

	# Next, identify ext'd parts, so to find out its (damned) children
	#
	LOG("Disco>     Identifying ext'd parts\n");

	my(@Extd) = ();
	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    if(Is_Part_Extended($D->{Types}->[$i]))
	    {
		push(@Extd, $i);
	    }
	}

	LOG("Disco>       Extd parts:\n");
	foreach(@Extd)
	{
	    LOG("Disco>         [".$_."] => [".$D->{Parts}->[$_]."]\n");
	}

	# Worth knowing which parts are located in an ext'd
	#
	LOG("Disco>     Identifying logical and not logical parts\n");

	my(@Not_Logical) = ();
	my(@Logical) = ();
	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    my $In_Extd = 0;
	    foreach my $d (@Extd)
	    {
		if($D->{Start}->[$i] >= $D->{Start}->[$d]
		   && $D->{End}->[$i] <= $D->{End}->[$d]
		   && $i != $d)
		{
		    ++ $In_Extd;
		    LOG("Disco>       Part [".$i."] ["
			.$D->{Parts}->[$i]."] in extd part [".$d."]\n");
		}
	    }
	    if($In_Extd)
	    {
		push(@Logical, $i);
	    }
	    else
	    {
		push(@Not_Logical, $i);
	    }
	}

	LOG("Disco>       Logical parts:\n");
	foreach(@Logical)
	{
	    LOG("Disco>         [".$_."] => [".$D->{Parts}->[$_]."]\n");
	}

	LOG("Disco>       Not Logical parts:\n");
	foreach(@Not_Logical)
	{
	    LOG("Disco>         [".$_."] => [".$D->{Parts}->[$_]."]\n");
	}

	# Now, find empty segments concerning only parts that are not
	# located in an extd part.
	#
	LOG("Disco>     Find empty segments outside not logical parts\n");

	foreach my $i (@Not_Logical)
	{
	    LOG("Disco>       Part [".$i."] / [".$D->{Parts}->[$i]."]\n");

	    # Must be one part finishing just before the start of current.
	    #
	    my $Closest_End = 0;
	    foreach my $j (@Not_Logical)
	    {
		if($D->{End}->[$j] < $D->{Start}->[$i]
		   && $D->{End}->[$j] > $Closest_End)
		{
		    $Closest_End = $D->{End}->[$j];
		}
	    }

	    LOG("Disco>         Closest part ends at block [$Closest_End]\n");

	    if($Closest_End < ($D->{Start}->[$i] - 1) && $Closest_End > 0)
	    {
		LOG("Disco>         (2) Found null segment ["
		    .($Closest_End + 1)."]-[".($D->{Start}->[$i] - 1)."]\n");

		push(@Parts, 'null');
		push(@Types, 'null');
		push(@FS_Types, 'null');
		push(@Dirs, 'null');
		push(@Labels, 'null');
		push(@Boot_Flags, 'null');
		push(@Start, $Closest_End + 1);
		push(@End, $D->{Start}->[$i] - 1);
		push(@Sectors, 'null');
		push(@Size, 'null');
		push(@Used_Space, 'null');
	    }
	    else
	    {
		LOG("Disco>           No space found.\n");
	    }
	}

	# And don't forget the last segment. Have to look after.
	# No possible problem with an extd part here.
	#
	LOG("Disco>     Find an empty segment after farest logical part\n");

	my $Farest_End = 0;
	for(my $j = 0; $j <= $#{ $D->{Parts} }; $j++)
	{
	    if($D->{Parts}->[$j] ne 'null'
	       && $D->{End}->[$j] > $Farest_End)
	    {
		$Farest_End = $D->{End}->[$j];
	    }
	}

	LOG("Disco>       Farest not logical part ends at block ["
	    .$Farest_End."]\n");

	if($Farest_End < $D->{Cylinders})
	{
	    LOG("Disco>       (3) Found null segment ["
		.($Farest_End + 1)."]-[".$D->{Cylinders}."]\n");

	    push(@Parts, 'null');
	    push(@Types, 'null');
	    push(@FS_Types, 'null');
	    push(@Dirs, 'null');
	    push(@Labels, 'null');
	    push(@Boot_Flags, 'null');
	    push(@Start, $Farest_End + 1);
	    push(@End, $D->{Cylinders});
	    push(@Sectors, 'null');
	    push(@Size, 'null');
	    push(@Used_Space, 'null');
	}
	else
	{
	    LOG("Disco>        No empty space found\n");
	}

	# Now, checks segments concerning only parts that are
	# located in an extd part.
	#
	LOG("Disco>     Find empty segments in ext'd parts\n");

	foreach my $d (@Extd)
	{
	    LOG("Disco>       Search ext'd part [".$d."] / [".$D->{Parts}->[$d]."]\n");

	    # Make sure there's one part at the beginning of the extd part
	    #
	    LOG("Disco>         Make sure it begins with one part\n");

	    my $First_Start = $D->{End}->[$d];
	    foreach my $i (@Logical)
	    {
		if($D->{Start}->[$i] >= $D->{Start}->[$d]
		   && $D->{End}->[$i] <= $D->{End}->[$d]
		   && $D->{Start}->[$i] < $First_Start
		   && $d != $i)
		{
		    $First_Start = $D->{Start}->[$i];
		}
	    }
	    LOG("Disco>           First Start: [".$First_Start."]\n");

	    if($First_Start > $D->{Start}->[$d])
	    {
		LOG("Disco>           (4) Found null segment ["
		    .($D->{Start}->[$d])."]-[".($First_Start - 1)."]\n");

		push(@Parts, 'null');
		push(@Types, 'null');
		push(@FS_Types, 'null');
		push(@Dirs, 'null');
		push(@Labels, 'null');
		push(@Boot_Flags, 'null');
		push(@Start, $D->{Start}->[$d]);
		push(@End, $First_Start - 1);
		push(@Sectors, 'null');
		push(@Size, 'null');
		push(@Used_Space, 'null');
	    }
	    else
	    {
		LOG("Disco>           No empty block at the beginning of this ext'd\n");
	    }

	    # Must be one part finishing just before the start of current.
	    #
	    LOG("Disco>         Check each contained part for space before it\n");

	    foreach my $i (@Logical)
	    {
		LOG("Disco>           Check part [".$i."] [".$D->{Parts}->[$i]."]\n");

		if($D->{Start}->[$i] < $D->{Start}->[$d]
		   || $D->{End}->[$i] > $D->{End}->[$d]
		   || $d == $i)
		{
		    LOG("Disco>             Out of scope. Next.\n");
		    next;
		}

		my $Closest_End = $D->{Start}->[$d];
		for(my $j = 0; $j <= $#{ $D->{Parts} }; $j++)
		{
		    if($D->{End}->[$j] > $Closest_End
		       && $D->{End}->[$j] < $D->{Start}->[$i])
		    {
			$Closest_End = $D->{End}->[$j];
		    }
		}

		LOG("Disco>             Closest part ends at block [".$Closest_End."]\n");

		if($Closest_End < ($D->{Start}->[$i] - 1))
		{
		    LOG("Disco>             (5) Found null segment ["
			.($Closest_End + 1)."]-[".($D->{Start}->[$i] - 1)."]\n");

		    if($Closest_End == $D->{Start}->[$d])
		    {
			LOG("Disco>               Ignoring it; 1st segment of ext'd\n");
			LOG("Disco>               already done.\n");
		    }
		    else
		    {
			push(@Parts, 'null');
			push(@Types, 'null');
			push(@FS_Types, 'null');
			push(@Dirs, 'null');
			push(@Labels, 'null');
			push(@Boot_Flags, 'null');
			push(@Start, $Closest_End + 1);
			push(@End, $D->{Start}->[$i] - 1);
			push(@Sectors, 'null');
			push(@Size, 'null');
			push(@Used_Space, 'null');
		    }
		}
		else
		{
		    LOG("Disco>             No space found.\n");
		}
	    }

	    # Check remaining space at the end of the ext'd
	    #
	    LOG("Disco>         Check for a segment at the end of the ext'd\n");

	    my $Farest_End = $D->{Start}->[$d];
	    foreach my $i (@Logical)
	    {
		if($D->{Start}->[$i] < $D->{Start}->[$d]
		   || $D->{End}->[$i] > $D->{End}->[$d]
		   || $d == $i)
		{
		    LOG("Disco>             Out of scope. Next.\n");
		    next;
		}
		if($D->{End}->[$i] > $Farest_End)
		{
		    $Farest_End = $D->{End}->[$i];
		}
	    }

	    LOG("Disco>           Farest part ends at block [".$Farest_End."]\n");

	    if($Farest_End < $D->{End}->[$d])
	    {
		LOG("Disco>             (6) Found null segment ["
		    .($Farest_End + 1)."]-[".$D->{End}->[$d]."]\n");

		push(@Parts, 'null');
		push(@Types, 'null');
		push(@FS_Types, 'null');
		push(@Dirs, 'null');
		push(@Labels, 'null');
		push(@Boot_Flags, 'null');
		push(@Start, $Farest_End + 1);
		push(@End, $D->{End}->[$d]);
		push(@Sectors, 'null');
		push(@Size, 'null');
		push(@Used_Space, 'null');
	    }
	    else
	    {
		LOG("Disco>             No space found.\n");
	    }
	}

	# Keep non-null partitions as well... :)
	#
	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    push(@Parts, $D->{Parts}->[$i]);
	    push(@Types, $D->{Types}->[$i]);
	    push(@FS_Types, $D->{FS_Types}->[$i]);
	    push(@Dirs, $D->{Dirs}->[$i]);
	    push(@Labels, $D->{Labels}->[$i]);
	    push(@Boot_Flags, $D->{Boot_Flags}->[$i]);
	    push(@Start, $D->{Start}->[$i]);
	    push(@End, $D->{End}->[$i]);
	    push(@Sectors, $D->{Sectors}->[$i]);
	    push(@Size, $D->{Sectors}->[$i] * $D->{BIOS_Sector_Size});
	    push(@Used_Space, Used_Space($D->{Parts}->[$i], 1));
	}

	# Storage!
	#
	$Rich{Parts} = \@Parts;
	$Rich{Types} = \@Types;
	$Rich{FS_Types} = \@FS_Types;
	$Rich{Dirs} = \@Dirs;
	$Rich{Labels} = \@Labels;
	$Rich{Boot_Flags} = \@Boot_Flags;
	$Rich{Start} = \@Start;
	$Rich{End} = \@End;
	$Rich{Sectors} = \@Sectors;
	$Rich{Size} = \@Size;
	$Rich{Used_Space} = \@Used_Space;

	push(@New, \%Rich);
    }

    LOG("Disco> * After handling the issue of possible unused segments,\n");
    LOG("Disco> * we found this:\n");
    HDD_Describe(\@New);

    @{ $pD } = @New;
}



# Retrieves the MD5 checksum of a file.
# If the file is too big, will truncate it and calculate over
# small, merged parts.
#
# Syntax: my $MD5 = MD5("$TMPDIR/myfile");
#
sub MD5
{
    my $Path = shift || '';
    return('') unless($Path && -e $Path);

    my $To_Calc = "";
    my $Size = (stat($Path))[7];
    if($Size < 1000000)
    {
	$To_Calc = $Path;
    }
    else
    {
	my $P = $Path;
	$P =~s/\$/\\\$/g;
#	$P =~s/\@/\\\@/g;
#	$P =~s/\%/\\\%/g;
#	$P =~s/\[/\\\[/g;
#	$P =~s/\]/\\\]/g;
	system("dd if=\"$P\" of=$TMPDIR/MD5.$$ count=1 bs=50000 >/dev/null 2>&1");
	system("tail --bytes=50000 \"$P\" >>$TMPDIR/MD5.$$");
	$To_Calc = "$TMPDIR/MD5.$$";
    }

    my $P = $To_Calc;
    $P =~s/\$/\\\$/g;
#    $P =~s/\@/\\\@/g;
#    $P =~s/\%/\\\%/g;
#    $P =~s/\[/\\\[/g;
#    $P =~s/\]/\\\]/g;

#   LOG("!!! [md5sum \"$P\"]\n");
    my $out = `md5sum "$P"`;
    $out = substr($out, 0, 32);

    if(-e $TMPDIR."/MD5.".$$)
    {
	unlink($TMPDIR."/MD5.".$$);
    }

    return($out);
}



# Convert each two-digit hex number back to an ASCII character.
#
sub hex_to_ascii($)
{
    (my $str = shift) =~ s/([a-fA-F0-9]{2})/chr(hex $1)/eg;
    return $str;
}



# Convert each ASCII character to a two-digit hex number.
#
sub ascii_to_hex($)
{
    (my $str = shift) =~ s/(.|\n)/sprintf("%02lx", ord $1)/eg;
    return $str;
}



# Writes a standard MBR to a device.
#
# To restore a NTFS MBR, dd ntfs.mbr to /dev/hda. Then, rebuild the p.table.
# Or, dd from 0000 to 01BD, and last two bytes (from 01FE to 01FF, the usual 55 AA)
# (the MBR can be taken from any Windows OS, or from public standard code).
#
sub Write_Std_MBR
{
    my $DEVICE = shift || '';

    $DEVICE =~s/^\/dev\///;

    LOG("Write_Std_MBR> * Writing a new MBR for device [".$DEVICE."]\n");

    my(@Bytes) = ("c033", "d08e", "00bc", "fb7c", "0750", "1f50", "befc", "7c1b",
		  "1bbf", "5006", "b957", "01e5", "a4f3", "bdcb", "07be", "04b1",
		  "6e38", "7c00", "7509", "8313", "10c5", "f4e2", "18cd", "f58b",
		  "c683", "4910", "1974", "2c38", "f674", "b5a0", "b407", "8b07",
		  "acf0", "003c", "fc74", "07bb", "b400", "cd0e", "eb10", "88f2",
		  "104e", "46e8", "7300", "fe2a", "1046", "7e80", "0b04", "0b74",
		  "7e80", "0c04", "0574", "b6a0", "7507", "80d2", "0246", "8306",
		  "0846", "8306", "0a56", "e800", "0021", "0573", "b6a0", "eb07",
		  "81bc", "fe3e", "557d", "74aa", "800b", "107e", "7400", "a0c8",
		  "07b7", "a9eb", "fc8b", "571e", "f58b", "bfcb", "0005", "568a",
		  "b400", "cd08", "7213", "8a23", "24c1", "983f", "de8a", "fc8a",
		  "f743", "8be3", "86d1", "b1d6", "d206", "42ee", "e2f7", "5639",
		  "770a", "7223", "3905", "0846", "1c73", "01b8", "bb02", "7c00",
		  "4e8b", "8b02", "0056", "13cd", "5173", "744f", "324e", "8ae4",
		  "0056", "13cd", "e4eb", "568a", "6000", "aabb", "b455", "cd41",
		  "7213", "8136", "55fb", "75aa", "f630", "01c1", "2b74", "6061",
		  "006a", "006a", "76ff", "ff0a", "0876", "006a", "0068", "6a7c",
		  "6a01", "b410", "8b42", "cdf4", "6113", "7361", "4f0e", "0b74",
		  "e432", "568a", "cd00", "eb13", "61d6", "c3f9", "6e49", "6176",
		  "696c", "2064", "6170", "7472", "7469", "6f69", "206e", "6174",
		  "6c62", "0065", "7245", "6f72", "2072", "6f6c", "6461", "6e69",
		  "2067", "706f", "7265", "7461", "6e69", "2067", "7973", "7473",
		  "6d65", "4d00", "7369", "6973", "676e", "6f20", "6570", "6172",
		  "6974", "676e", "7320", "7379", "6574", "006d", "0000", "0000",
		  "0000", "0000", "0000", "0000", "0000", "0000", "0000", "0000",
		  "0000", "0000", "0000", "0000", "0000", "0000", "0000", "0000",
		  "0000", "0000", "0000", "0000", "0000", "0000", "0000", "0000",
		  "0000", "0000", "2c00", "6344", "0000", "0000", "0000");

    open(OUT, ">".$TMPDIR."/mbr.1.".$$);
    binmode(OUT);
    foreach my $Curr (@Bytes)
    {
	my $Rev = substr($Curr, 2, 2).substr($Curr, 0, 2);
	print OUT hex_to_ascii($Rev);
    }
    close(OUT);
    LOG("Write_Std_MBR>   Wrote [".$TMPDIR."/mbr.1.".$$."]\n");
    my $Hex = `hexdump $TMPDIR/mbr.1.$$`;
    LOG("Write_Std_MBR>     Contents: [".$Hex."]\n");

    open(OUT, ">".$TMPDIR."/mbr.2.".$$);
    binmode(OUT);
    my $A = "55aa";
    print OUT hex_to_ascii($A);
    close(OUT);
    LOG("Write_Std_MBR>   Wrote [".$TMPDIR."/mbr.2.".$$."]\n");
    $Hex = `hexdump $TMPDIR/mbr.2.$$`;
    LOG("Write_Std_MBR>     Contents: [".$Hex."]\n");

    Exec_Log("dd if=$TMPDIR/mbr.1.$$ of=/dev/$DEVICE", 0, "Write_Std_MBR>   ");
    Exec_Log("dd if=/dev/$DEVICE of=$TMPDIR/$DEVICE.$$ count=1 bs=510", 0,
	     "Write_Std_MBR>   ");
    Exec_Log("cat $TMPDIR/mbr.2.$$ >>$TMPDIR/$DEVICE.$$", 0, "Write_Std_MBR>   ");
    Exec_Log("dd if=$TMPDIR/$DEVICE.$$ of=/dev/$DEVICE", 0, "Write_Std_MBR>   ");

    foreach($TMPDIR."/mbr.1.".$$, $TMPDIR."/mbr.2.".$$, $TMPDIR."/".$DEVICE.".".$$)
    {
	if(-e $_)
	{
	    unlink($_);
	}
    }
}



# Replaces Dell's proprietary MBR with a standard one.
#
# Fixes the DELL NTFS boot sector. The one shipped with Dell boxes
# has a number of hidden sectors that was OK as long as we had a
# /dev/hda1 Dell Utility partition. Once removed, 1Ch must be fixed.
#
sub Fix_Dell_Boot
{
    my $DEVICE = shift || '';

    $DEVICE =~s/^\/dev\///;

    LOG("Fix_Dell_Boot> * Fixing the number of hidden sectors for [".$DEVICE."]\n");

    Exec_Log("dd if=/dev/$DEVICE of=$TMPDIR/$DEVICE.$$ bs=512 count=16", 0,
	     "Fix_Dell_Boot>   ");

    my $byteCount = 0;

    open(IN, "< ".$TMPDIR."/".$DEVICE.".".$$);
    binmode(IN);
    open(OUT, "> ".$TMPDIR."/".$DEVICE.".".$$.".new");

    my $Value = 63;    # 63 hidden sectors, for the MBR + 62 empty.

    binmode(OUT);
    while(read(IN, $b, 1))
    {
	if($byteCount == 28)
	{
	    my $tmp = sprintf("%x", $Value);
	    while(length($tmp) < 8)
	    {
		$tmp = "0".$tmp;
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 6, 2)))), 0, 1));
	}
	elsif($byteCount == 29)
	{
	    my $tmp = sprintf("%x", $Value);
	    while(length($tmp) < 8)
	    {
		$tmp = "0".$tmp;
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 4, 2)))), 0, 1));
	}
	elsif($byteCount == 30)
	{
	    my $tmp = sprintf("%x", $Value);
	    while(length($tmp) < 8)
	    {
		$tmp = "0".$tmp;
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 2, 2)))), 0, 1));
	}
	elsif($byteCount == 31)
	{
	    my $tmp = sprintf("%x", $Value);
	    while(length($tmp) < 8)
	    {
		$tmp = "0".$tmp;
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 0, 2)))), 0, 1));
	}
	else
	{
	    print(OUT $b);
	}

	$byteCount++;
    }

    close(IN);
    close(OUT);

    LOG("Fix_Dell_Boot>   Wrote [".$byteCount."] bytes.\n");

    my $Hex = `hexdump $TMPDIR/$DEVICE.$$`;
    LOG("Fix_Dell_Boot>     Contents of [".$TMPDIR."/".$DEVICE.".".$$."]: [".$Hex."]\n");
    $Hex = `hexdump $TMPDIR/$DEVICE.$$.new`;
    LOG("Fix_Dell_Boot>     Contents of [".$TMPDIR."/".$DEVICE.".".$$.".new]: [".$Hex."]\n");

    Exec_Log("dd if=$TMPDIR/$DEVICE.$$.new of=/dev/$DEVICE", 0, "Fix_Dell_Boot>   ");

    foreach($TMPDIR."/".$DEVICE.".".$$, $TMPDIR."/".$DEVICE.".".$$.".new")
    {
	if(-e $_)
	{
	    unlink($_);
	}
    }
}



sub Read_Dir
{
    # Pointers.
    my($pF) = shift;
    my($pFF) = shift;
    my($pMulti) = shift;

    # $SRC and $Entity need no pointer as they are global vars...

    return unless($pF && $pFF && $pMulti);

    LOG("READ_DIR> Sort dir files according to task priority\n");

    opendir(DIR, $SRC."/".$Entity);
    @{ $pF } = readdir(DIR);
    closedir(DIR);

    # Resolving symlinks
    #
    LOG("READ_DIR>   Resolving possible symlinks\n");
    LOG("READ_DIR>   Before:\n");
    foreach(@{ $pF })
    {
        LOG("READ_DIR>     [".$_."]\n");
    }
    @{ $pFF } = ();
    foreach my $F (@{ $pF })
    {
        next if($F =~/^\.{1,2}/);
        if($F =~/\.symlink/i)
	{
            my $Link = "";
            open(DB, $SRC."/".$Entity."/".$F);
            while(<DB>)
	    {
                $Link .= $_;
            }
            close(DB);
            $Link =~s/^\s*//;
            $Link =~s/\s*$//;
            $Link =~s/\\/\//g;
            LOG("READ_DIR>     Symlink. Points to [".$Link."]\n");
            if(-e $SRC."/".$Entity."/".$Link)
            {
                push(@{ $pFF }, $SRC."/".$Entity."/".$Link);
            }
            else
            {
                LOG("READ_DIR>       [".$SRC."/".$Entity."/".$Link."] can't be found!!!\n");
                sleep($FAILED_SLEEP);
                next;
            }
        }
	else
	{
	    # Added for cciss compatabililty (HP SmartArray). Idem for ida and rd.
	    #
            if($F =~/(cciss|ida|rd|mapper)/i)
	    {
		opendir(DIR, $SRC."/".$Entity."/".$F);
		my(@tmp) = readdir(DIR);
		closedir(DIR);
		foreach(@tmp)
		{
		    next if(m/^\.{1,2}$/);
		    push(@{ $pFF }, $SRC."/".$Entity."/".$F."/".$_);
		}
		closedir(DIR);
	    }
	    #
	    # All non-CCISS/rd/ida/mapper cases
	    #
	    else
	    {
		push(@{ $pFF }, $SRC."/".$Entity."/".$F);
            }
	}
    }
    foreach(@{ $pFF })
    {
	s/\/+/\//g;
    }
    LOG("READ_DIR>   After:\n");
    foreach(@{ $pFF })
    {
        LOG("READ_DIR>     [".$_."]\n");
    }

    # Sorting data.
    #
    LOG("READ_DIR>   Re-ordering\n");
    my @files = @{ $pFF };
    @{ $pFF } = ();
    foreach(@files)
    {
	if(m/^addon(\-|_).*\.tar\.(gz|bz2|xz)$/i || m/^addon(\-|_).*\.zip$/i)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/^ping\.conf$/i)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/\/bios$/)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/\/[hs]d[abcdef]$/
	   || m/md\d+$/i
	   || m/askme_[abcdef]$/i)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/(cciss|ida|rd|mapper)\/c\dd\d$/
	   || m/mapper\/VolGroup\d{2}\-LogVol\d{2}$/)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/^[hs]d[abcdef]\.fsa$/)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/\.first_sectors$/ || m/\.fir$/)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(! m/\/bios$/
	   && ! m/\/[hs]d[abcdef]$/ && ! m/(cciss|ida|rd|mapper)\/c\dd\d$/
	   && ! m/mapper\/VolGroup\d{2}\-LogVol\d{2}$/
	   && ! m/\.first_sectors$/ && ! m/\.fir$/ && ! m/MULTI$/i
	   && ! m/\/md\d+$/
	   && ! m/askme_[abcdef]$/i)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/\.RecFiles\.txt$/i)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/MULTI$/i)
	{
	    push(@{ $pFF }, $_);
	    ${ $pMulti } = 1;
	}
    }
    foreach(@files)
    {
	if(m/^Help_Dell$/i)
	{
	    push(@{ $pFF }, $_);
	}
    }
    LOG("READ_DIR>   Re-ordered:\n");
    foreach(@{ $pFF })
    {
        LOG("READ_DIR>     [".$_."]\n");
    }
}



sub Feed_Dev_Nodes
{
    (%DEV_NODES) = (
	"hda" => {minor => 3, major => 0},
	"hdb" => {minor => 3, major => 64},
	"hdc" => {minor => 22, major => 0},
	"hdd" => {minor => 22, major => 64},
	"hde" => {minor => 33, major => 0},
	"hdf" => {minor => 33, major => 64},
	"hdg" => {minor => 34, major => 0},
	"hdh" => {minor => 34, major => 64},
	"eda" => {minor => 36, major => 0},
	"edb" => {minor => 36, major => 64},
	"pda" => {minor => 45, major => 0},
	"pdb" => {minor => 45, major => 16},
	"pdc" => {minor => 45, major => 32},
	"pdd" => {minor => 45, major => 48},
	"hdi" => {minor => 56, major => 0},
	"hdj" => {minor => 56, major => 64},
	"hdk" => {minor => 57, major => 0},
	"hdl" => {minor => 57, major => 64},
	);

    for(my $i = 1; $i <= 63; $i++)
    {
	$DEV_NODES{"hda$i"} = {minor => 3, major => $i};
	$DEV_NODES{"hdb$i"} = {minor => 3, major => 64 + $i};
	$DEV_NODES{"hdc$i"} = {minor => 22, major => $i};
	$DEV_NODES{"hdd$i"} = {minor => 22, major => 64 + $i};
	$DEV_NODES{"hde$i"} = {minor => 33, major => $i};
	$DEV_NODES{"hdf$i"} = {minor => 33, major => 64 + $i};
	$DEV_NODES{"hdg$i"} = {minor => 34, major => $i};
	$DEV_NODES{"hdh$i"} = {minor => 34, major => 64 + $i};
	$DEV_NODES{"eda$i"} = {minor => 36, major => $i};
	$DEV_NODES{"edb$i"} = {minor => 36, major => 64 + $i};
	$DEV_NODES{"hdi$i"} = {minor => 56, major => $i};
	$DEV_NODES{"hdj$i"} = {minor => 56, major => 64 + $i};
	$DEV_NODES{"hdk$i"} = {minor => 57, major => $i};
	$DEV_NODES{"hdl$i"} = {minor => 57, major => 64 + $i};
    }

    # sda - sdp
    for(my $i = 0; $i <= 15; $i++)
    {
	$DEV_NODES{"sd".$ALPH[$i]} = {minor => 8, major => 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sd".$ALPH[$i].$j} = {minor => 8, major => 16 * $i + $j};
	}
    }

    # sdq - sdz
    for(my $i = 16; $i <= 25; $i++)
    {
	$DEV_NODES{"sd".$ALPH[$i]} = {minor => 65, major => 16 * ($i - 16)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sd".$ALPH[$i].$j} = {minor => 65, major => 16 * ($i - 16) + $j};
	}
    }

    # sdaa - sdaf
    for(my $i = 0; $i <= 5; $i++)
    {
	$DEV_NODES{"sda".$ALPH[$i]} = {minor => 65, major => 240-5*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sda".$ALPH[$i].$j} = {minor => 65, major => 240-5*16 + 16 * $i + $j};
	}
    }

    # sdag - sdav
    for(my $i = 7; $i <= 20; $i++)
    {
	$DEV_NODES{"sda".$ALPH[$i]} = {minor => 66, major => 16 * ($i - 6)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sda".$ALPH[$i].$j} = {minor => 66, major => 16 * ($i - 6) + $j};
	}
    }

    # sdaw - sdaz
    for(my $i = 21; $i <= 25; $i++)
    {
	$DEV_NODES{"sda".$ALPH[$i]} = {minor => 67, major => 16 * ($i - 21)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sda".$ALPH[$i].$j} = {minor => 67, major => 16 * ($i - 21) + $j};
	}
    }

    # sdba - sdbl
    for(my $i = 0; $i <= 11; $i++)
    {
	$DEV_NODES{"sdb".$ALPH[$i]} = {minor => 67, major => 240-11*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdb".$ALPH[$i].$j} = {minor => 67, major => 240-11*16 + 16 * $i + $j};
	}
    }

    # sdbm - sdbz
    for(my $i = 12; $i <= 25; $i++)
    {
	$DEV_NODES{"sdb".$ALPH[$i]} = {minor => 68, major => 16 * ($i - 12)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdb".$ALPH[$i].$j} = {minor => 68, major => 16 * ($i - 12) + $j};
	}
    }

    # sdca - sdcb
    for(my $i = 0; $i <= 1; $i++)
    {
	$DEV_NODES{"sdc".$ALPH[$i]} = {minor => 68, major => 240-1*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdc".$ALPH[$i].$j} = {minor => 68, major => 240-1*16 + 16 * $i + $j};
	}
    }

    # sdcc - sdcr
    for(my $i = 2; $i <= 17; $i++)
    {
	$DEV_NODES{"sdc".$ALPH[$i]} = {minor => 69, major => 16 * ($i - 2)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdc".$ALPH[$i].$j} = {minor => 69, major => 16 * ($i - 2) + $j};
	}
    }

    # sdcs - sdcz
    for(my $i = 18; $i <= 25; $i++)
    {
	$DEV_NODES{"sdc".$ALPH[$i]} = {minor => 70, major => 16 * ($i - 18)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdc".$ALPH[$i].$j} = {minor => 70, major => 16 * ($i - 18) + $j};
	}
    }

    # sdda - sddh
    for(my $i = 0; $i <= 7; $i++)
    {
	$DEV_NODES{"sdd".$ALPH[$i]} = {minor => 70, major => 240-7*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdd".$ALPH[$i].$j} = {minor => 70, major => 240-7*16 + 16 * $i + $j};
	}
    }

    # sddi - sddx
    for(my $i = 8; $i <= 23; $i++)
    {
	$DEV_NODES{"sdd".$ALPH[$i]} = {minor => 71, major => 16 * ($i - 8)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdd".$ALPH[$i].$j} = {minor => 71, major => 16 * ($i - 8) + $j};
	}
    }

    # sddy - sddz
    for(my $i = 24; $i <= 25; $i++)
    {
	$DEV_NODES{"sdd".$ALPH[$i]} = {minor => 128, major => 16 * ($i - 24)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdd".$ALPH[$i].$j} = {minor => 128, major => 16 * ($i - 24) + $j};
	}
    }

    # sdea - sden
    for(my $i = 0; $i <= 13; $i++)
    {
	$DEV_NODES{"sde".$ALPH[$i]} = {minor => 128, major => 32 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sde".$ALPH[$i].$j} = {minor => 128, major => 32 + 16 * $i + $j};
	}
    }

    # sdeo - sdez
    for(my $i = 14; $i <= 25; $i++)
    {
	$DEV_NODES{"sde".$ALPH[$i]} = {minor => 129, major => 16 * ($i - 14)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sde".$ALPH[$i].$j} = {minor => 129, major => 16 * ($i - 14) + $j};
	}
    }

    # sdfa - sdfd
    for(my $i = 0; $i <= 3; $i++)
    {
	$DEV_NODES{"sdf".$ALPH[$i]} = {minor => 129, major => 240-3*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdf".$ALPH[$i].$j} = {minor => 129, major => 240-3*16 + 16 * $i + $j};
	}
    }

    # sdfe - sdft
    for(my $i = 4; $i <= 19; $i++)
    {
	$DEV_NODES{"sdf".$ALPH[$i]} = {minor => 130, major => 16 * ($i - 4)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdf".$ALPH[$i].$j} = {minor => 130, major => 16 * ($i - 4) + $j};
	}
    }

    # sdfu - sdfz
    for(my $i = 20; $i <= 25; $i++)
    {
	$DEV_NODES{"sdf".$ALPH[$i]} = {minor => 131, major => 16 * ($i - 20)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdf".$ALPH[$i].$j} = {minor => 131, major => 16 * ($i - 20) + $j};
	}
    }

    # sdga - sdgj
    for(my $i = 0; $i <= 9; $i++)
    {
	$DEV_NODES{"sdg".$ALPH[$i]} = {minor => 131, major => 240-9*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdg".$ALPH[$i].$j} = {minor => 131, major => 240-9*16 + 16 * $i + $j};
	}
    }

    # sdgk - sdgz
    for(my $i = 10; $i <= 25; $i++)
    {
	$DEV_NODES{"sdg".$ALPH[$i]} = {minor => 132, major => 16 * ($i - 10)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"sdg".$ALPH[$i].$j} = {minor => 132, major => 16 * ($i - 10) + $j};
	}
    }

    # pda - pdd
    for(my $i = 0; $i <= 15; $i++)
    {
	$DEV_NODES{"pda".$i} = {minor => 45, major => $i};
	$DEV_NODES{"pdb".$i} = {minor => 45, major => $i};
	$DEV_NODES{"pdc".$i} = {minor => 45, major => $i};
	$DEV_NODES{"pdd".$i} = {minor => 45, major => $i};
    }

    # rd/c*d* and partitions rd/c*d*p*
    for(my $i = 0; $i <= 31; $i++)
    {
	for(my $k = 0; $k <= 7; $k++)
	{
	    $DEV_NODES{"rd/c".$k."d".$i} = {minor => 48 + $k, major => 8 * $i};
	}
	for(my $j = 1; $j <= 7; $j++)
	{
	    for(my $k = 0; $k <= 7; $k++)
	    {
		$DEV_NODES{"rd/c".$k."d".$i."p".$j} = {minor => 48 + $k, major => 8 * $i + $j};
	    }
	}
	for(my $k = 8; $k <= 15; $k++)
	{
	    $DEV_NODES{"rd/c".$k."d".$i} = {minor => 136 - 8 + $k, major => 8 * $i};
	}
	for(my $j = 1; $j <= 7; $j++)
	{
	    for(my $k = 8; $k <= 15; $k++)
	    {
		$DEV_NODES{"rd/c".$k."d".$i."p".$j} = {minor => 136 - 8 + $k, major => 8 * $i + $j};
	    }
	}
    }

    # ida/c*d* and partitions ida/c*d*p*
    for(my $i = 0; $i <= 15; $i++)
    {
	for(my $k = 0; $k <= 7; $k++)
	{
	    $DEV_NODES{"ida/c".$k."d".$i} = {minor => 72 + $k, major => 16 * $i};
	}
	for(my $j = 1; $j <= 15; $j++)
	{
	    for(my $k = 0; $k <= 7; $k++)
	    {
		$DEV_NODES{"ida/c".$k."d".$i."p".$j} = {minor => 72 + $k, major => 16 * $i + $j};
	    }
	}
    }

    # i2o/hda - i2o/hdp
    for(my $i = 0; $i <= 15; $i++)
    {
	$DEV_NODES{"i2o/hd".$ALPH[$i]} = {minor => 80, major => 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hd".$ALPH[$i].$j} = {minor => 80, major => 16 * $i + $j};
	}
    }

    # i2o/hdq - i2o/hdz
    for(my $i = 16; $i <= 25; $i++)
    {
	$DEV_NODES{"i2o/hd".$ALPH[$i]} = {minor => 81, major => 16 * ($i - 16)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hd".$ALPH[$i].$j} = {minor => 81, major => 16 * ($i - 16) + $j};
	}
    }

    # i2o/hdaa - i2o/hdaf
    for(my $i = 0; $i <= 5; $i++)
    {
	$DEV_NODES{"i2o/hda".$ALPH[$i]} = {minor => 81, major => 240-5*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hda".$ALPH[$i].$j} = {minor => 81, major => 240-5*16 + 16 * $i + $j};
	}
    }

    # i2o/hdag - i2o/hdav
    for(my $i = 6; $i <= 21; $i++)
    {
	$DEV_NODES{"i2o/hda".$ALPH[$i]} = {minor => 82, major => 16 * ($i - 6)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hda".$ALPH[$i].$j} = {minor => 82, major => 16 * ($i - 6) + $j};
	}
    }

    # i2o/hdaw - i2o/hdaz
    for(my $i = 21; $i <= 25; $i++)
    {
	$DEV_NODES{"i2o/hda".$ALPH[$i]} = {minor => 83, major => 16 * ($i - 21)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hda".$ALPH[$i].$j} = {minor => 83, major => 16 * ($i - 21) + $j};
	}
    }

    # i2o/hdba - i2o/hdbl
    for(my $i = 0; $i <= 11; $i++)
    {
	$DEV_NODES{"i2o/hdb".$ALPH[$i]} = {minor => 83, major => 240-11*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hdb".$ALPH[$i].$j} = {minor => 83, major => 240-11*16 + 16 * $i + $j};
	}
    }

    # i2o/hdbm - i2o/hdbz
    for(my $i = 12; $i <= 25; $i++)
    {
	$DEV_NODES{"i2o/hdb".$ALPH[$i]} = {minor => 84, major => 16 * ($i - 12)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hdb".$ALPH[$i].$j} = {minor => 84, major => 16 * ($i - 12) + $j};
	}
    }

    # i2o/hdca - i2o/hdcc
    for(my $i = 0; $i <= 2; $i++)
    {
	$DEV_NODES{"i2o/hdc".$ALPH[$i]} = {minor => 84, major => 240-2*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hdc".$ALPH[$i].$j} = {minor => 84, major => 240-2*16 + 16 * $i + $j};
	}
    }

    # i2o/hdcc - i2o/hdcr
    for(my $i = 2; $i <= 17; $i++)
    {
	$DEV_NODES{"i2o/hdc".$ALPH[$i]} = {minor => 85, major => 16 * ($i - 2)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hdc".$ALPH[$i].$j} = {minor => 85, major => 16 * ($i - 2) + $j};
	}
    }

    # i2o/hdcs - i2o/hdcz
    for(my $i = 18; $i <= 25; $i++)
    {
	$DEV_NODES{"i2o/hdc".$ALPH[$i]} = {minor => 86, major => 16 * ($i - 18)};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hdc".$ALPH[$i].$j} = {minor => 86, major => 16 * ($i - 18) + $j};
	}
    }

    # i2o/hdda - i2o/hddh
    for(my $i = 0; $i <= 7; $i++)
    {
	$DEV_NODES{"i2o/hdd".$ALPH[$i]} = {minor => 86, major => 240-7*16 + 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"i2o/hdd".$ALPH[$i].$j} = {minor => 86, major => 240-7*16 + 16 * $i + $j};
	}
    }

    # 87 / i2o/hddi - i2o/hddx
    # 88 / hdm - hdn
    # 89 / hdo - hdp
    # 90 / hdq - hdr
    # 91 / hds - hdt
    # 94 / dasda - dasdb

    # amiraid/ar* and partitions amiraod/ar*p*
    for(my $i = 0; $i <= 15; $i++)
    {
	$DEV_NODES{"amiraid/ar".$i} = {minor => 101, major => 16 * $i};
	for(my $j = 1; $j <= 15; $j++)
	{
	    $DEV_NODES{"amiraid/ar".$i."p".$j} = {minor => 101, major => 16 * $i + $j};
	}
    }

    # cciss/c*d* and partitions cciss/c*d*p*
    for(my $i = 0; $i <= 15; $i++)
    {
	for(my $k = 0; $k <= 7; $k++)
	{
	    $DEV_NODES{"cciss/c".$k."d".$i} = {minor => 104 + $k, major => 16 * $i};
	}
	for(my $j = 1; $j <= 15; $j++)
	{
	    for(my $k = 0; $k <= 7; $k++)
	    {
		$DEV_NODES{"cciss/c".$k."d".$i."p".$j} = {minor => 104 + $k, major => 16 * $i + $j};
	    }
	}
    }

    # 112 / iseries/vda - iseries/vdaf
    for(my $i = 0; $i <= 25; $i++)
    {
	$DEV_NODES{"iseries/vd".$ALPH[$i]} = {minor => 112, major => 8 * $i};
	for(my $j = 1; $j <= 7; $j++)
	{
	    $DEV_NODES{"iseries/vd".$ALPH[$i].$j} = {minor => 112, major => 8 * $i + $j};
	}
    }

    # 112 / iseries/vdaa - iseries/vdaf
    for(my $i = 0; $i <= 5; $i++)
    {
	$DEV_NODES{"iseries/vda".$ALPH[$i]} = {minor => 112, major => 208 + 8 * $i};
	for(my $j = 1; $j <= 7; $j++)
	{
	    $DEV_NODES{"iseries/vda".$ALPH[$i].$j} = {minor => 112, major => 208 + 8 * $i + $j};
	}
    }

    # 114 / ataraid/d* -- partitions ataraid/d*p*
    for(my $i = 0; $i <= 15; $i++)
    {
	$DEV_NODES{"ataraid/d".$i} = {minor => 114, major => 16 * $i};
	for(my $j = 0; $j <= 15; $j++)
	{
	    $DEV_NODES{"ataraid/d".$i."p".$j} = {minor => 114, major => 16 * $i + $j};
	}
    }

    # 133 / sdha - sdhp
    # 134 / sdhq - sdif
    # 135 / sdig - sdiv

    # 160, faire
}



sub Show_Logo
{
    print '                 ____   ____ _   __ ______   __ __     ____  '."\n";
    print '                / __ \ /  _// | / // ____/  / // /    / __ \ '."\n";
    print '               / /_/ / / / /  |/ // / __   / // /_   / / / / '."\n";
    print '              / ____/_/ / / /|  // /_/ /  /__  __/_ / /_/ /  '."\n";
    print '             /_/    /___//_/ |_/ \____/     /_/  (_)\____/   '."\n";
}




__END__

=== Todos ===

7/1/16
! Fait encore du Disco sur /dev/sda alors que seul sdb a le LVM
! A su enregistrer, ne saura pas restaurer
! M''a zsplitte du swap sur LVM


  - No more boot.ini if Windows 10.

    [root@localhost rootfs]# ls -l /dev/mapper/
    total 0
    crw------- 1 root root 10, 236 Dec 16 19:13 control
    lrwxrwxrwx 1 root root       7 Dec 16 19:13 fedora-home -> ../dm-1
    lrwxrwxrwx 1 root root       7 Dec 16 19:13 fedora-root -> ../dm-0
    lrwxrwxrwx 1 root root       7 Dec 16 19:13 fedora-tmp -> ../dm-3
    lrwxrwxrwx 1 root root       7 Dec 16 19:13 fedora-var -> ../dm-2

  - HELP_DELL well, maybe not any more! 2014, still found.
    They love that P* of S*.
  - Order of imaging tools... devrait etre defini autrement, voire par part.
  - According to Disco, imaging tools bound to fail should not be launched at all.
  - Must cope with Linux systems much much better.
    Maybe should we rebuild Grub/fstab so Linux will boot.
    Even more! network settings, hostname... or let users provide script to
    be run after. This, we already have.
  - Are some SD/MMC cards on ex.: /dev/mmcblk0p1 ? or /dev/block/mmcblkXpY ?
    Many say, will be /dev/sd* as usual.

  - Re-discover devices after applying the 512-byte dd file.
    Correct disk geometry if visibly wrong.
  - Correct any boot.ini ? what if W10 ?
  - tar+gz => grub doesn''t work.
  - Add support for ReiserFS. No. He''s in jail, and his FS is superseded.
  - Its_HDA_Stupid, don''t ask if two drives the source included.
  - Bug with ntfsresize after Auto_Extend...=Y and extended.
  - Sometimes, /dev/sda is a one-part device and must be mounted
    (usb devices). Maybe its mounting should be tested.

=== Hypothetical todos ===

  - Would be nice if a boot sector could be written... instead of
    dd-ing 20 first sectors of /dev/(h|s)da*. And FSs formated.
    But in that case, possible RAIDs should be rebuilt ?...
    Seems somewhat complicated.

  - Recreate_All_Parts should recreate labels, some day.

  - Zsplit can write to a ftp-mounted share: -c ... > /mnt/smbfs/aaa.
    Slow but working. Maybe an option. Yet, most people should prefer
    partimaging to a local device or LAN share, then upload to a FTP.
    Maybe it would be useful for support teams, though.

  - Yes piping partimage to  mkisofs and cdrecord/growisofs was what I
    thought                           of.                          The
    http://www.faqs.org/docs/Linux-HOWTO/CD-Writing-HOWTO.html    said
    that  such direct  piping  would be  unreliable  on machines  with
    CPU<400Mhz   and    with   disk   intensive    processes   running
    simultaneously. Well most machines have CPUs > 400Mhz and the only
    disk process running  is partimage. Yes it is true  I also have an
    older PC with CPU just about 233 Mhz. But that PC also came with a
    HDD of just 1,6 Gbyte and without CD burner.

    Having partimage to  store backup data temporarily locally  (like on a
    RAM  disk or  USB flash  disk or  a small  local partition  - whatever
    device available), burning these onto  multisession CD or DVD when the
    storage capacity  of the  temporary local device  is reached  and then
    continuing with partimage repeating  these steps until the full system
    backup is completed is also not bad idea.

    I think  almost anybody can burn  locally saved files on  to CD/DVD as
    long  as these  files are  smaller then  the storage  capacity  of the
    CD/DVD.  In   this  case  the   necessity  for  a  huge   empty  local
    partition/device remains. (petknize)

  - Proposed on a forum: to add this to the APPEND line:
      locale=fr_FR bootkbd=fr console-setup/layoutcode=fr \
      console-setup/variantcode=nodeadkeys
    Maybe some day, it will be worth adding these local keyboards, finally :p

  - dmraid -ay
    => We get:
       crw------- 1 root root  10, 62 Oct 28 12:48 control
       brw------- 1 root root 253,  0 Oct 28 12:48 isw_bidfbdeiab_TRACE
       brw------- 1 root root 253,  1 Oct 28 12:48 isw_bidfbdeiab_TRACE1
       brw------- 1 root root 253,  2 Oct 28 12:48 isw_bidfbdeiab_TRACE2
       brw------- 1 root root 253,  3 Oct 28 12:48 isw_bidfbdeiab_TRACE3

       Disk /dev/mapper/isw_bidfbdeiab_TRACE: 80.0 GB, 80023126016 bytes
       255 heads, 63 sectors/track, 9728 cylinders
       Units = cylinders of 16065 * 512 = 8225280 bytes

                                  Device Boot Start    End    Blocks Id  System
       /dev/mapper/isw_bidfbdeiab_TRACE1   *      1   4853  38981691  7  HPFS/NTFS
       /dev/mapper/isw_bidfbdeiab_TRACE2       4854   8933  32772600  c  W95 FAT32 (LBA)
       /dev/mapper/isw_bidfbdeiab_TRACE3       8934   9728   6385837+ c  W95 FAT32 (LBA)

       Disk /dev/sda: 80.0 GB, 80026361856 bytes
       255 heads, 63 sectors/track, 9729 cylinders
       Units = cylinders of 16065 * 512 = 8225280 bytes

          Device Boot      Start         End      Blocks   Id  System
       /dev/sda1   *           1        4853    38981691    7  HPFS/NTFS
       /dev/sda2            4854        8933    32772600    c  W95 FAT32 (LBA)
       /dev/sda3            8934        9728     6385837+   c  W95 FAT32 (LBA)


=== Remember... ===

* Disk geometry (>2015):

Ex.: blockdev --getsize64 /dev/sdb1   = 64423460864 bytes
     blockdev --getsz /dev/sdb1       = 125827072   sectors (of 512 bytes)
     blockdev --getbsz /dev/sdb       = 4096        is the block size in bytes
     So, there are 64423460864 / 4096 = 15728384    blocks

Dev_Size          = Heads * Nb_Sectors_by_Track * Dev_Cylinders * Sector_Size
60G = 64423460864 = 255   * 63                  * 7832          * 512

Disk /dev/sdb: 60 GiB, 64424509440 bytes, 125829120 sectors
Units: sectors of 1 * 512 = 512 bytes
Sector size (logical/physical): 512 bytes / 512 bytes
I/O size (minimum/optimal): 512 bytes / 512 bytes
Disklabel type: dos
Disk identifier: 0x713b4f33

Device     Boot Start       End   Sectors Size Id Type
/dev/sdb1  *     2048 125827071 125825024  60G  7 HPFS/NTFS/exFAT


* Creating LVM:

fdisk ... 8e
pvcreate /dev/hda2
vgcreate VolGroup00 /dev/hda2
vgscan
vgchange -ay
lvcreate -L1500 -nVol01 VolGroup00 /dev/hda2

dd if=/dev/hda2 of=... bs=512 count=20   => OK

* Dell utilities... fdisk output:

Disk /dev/sda: 120GB, 1200341234123776 bytes
255 heads, 63 sectors/track, 14593 cylinders
Units cylinders of 16065 * 512 = 8225280 bytes

Device    Boot Start End    Blocks    Id System
/dev/sda1      1     12     96358+    de Dell Utility
/dev/sda2 *    13    14592  117113850 7  HPFS/NTFS

* ntfsresize error

Checking Filesystem Consistency...
[Runs to 100%]
Accounting Clusters
Space in use: 5595Mb (7.0%)
Collecting resizing contraints...
Needed relocations 48395 (199Mb)
Schedule chkdsk for NTFS consistency check at Windows boot time...
Resetting $LogFile...
Relocating needed data
[Fails at 52.28%]
ERROR: Extended record needed (1392 > 1024), not yet supported! Please try to free less space. 

* NFS

mount -t nfs -o nolock SERVER:/home/y/share/ping /mnt/smbfs
The nolock option is not really to be used... yet reported to help, maybe.

* S-Tar

Enhanced tar archive containing ACLs (but not for NTFS):
star -c -acl artype=xustar mydir > a.tar

* PartClone

/usr/sbin/partclone.VMFS_volume_member  /usr/sbin/partclone.hfs+
/usr/sbin/partclone.btrfs               /usr/sbin/partclone.hfsp
/usr/sbin/partclone.chkimg              /usr/sbin/partclone.hfsplus
/usr/sbin/partclone.dd                  /usr/sbin/partclone.info
/usr/sbin/partclone.ext2                /usr/sbin/partclone.ntfs
/usr/sbin/partclone.ext3                /usr/sbin/partclone.ntfsfixboot
/usr/sbin/partclone.ext4                /usr/sbin/partclone.ntfsreloc
/usr/sbin/partclone.ext4dev             /usr/sbin/partclone.reiser4
/usr/sbin/partclone.extfs               /usr/sbin/partclone.reiserfs
/usr/sbin/partclone.fat                 /usr/sbin/partclone.restore
/usr/sbin/partclone.fat12               /usr/sbin/partclone.ufs
/usr/sbin/partclone.fat16               /usr/sbin/partclone.vfat
/usr/sbin/partclone.fat32               /usr/sbin/partclone.vmfs
/usr/sbin/partclone.fstype              /usr/sbin/partclone.xfs

root:/# partclone.ext4 --help
partclone.extfs v0.2.24 http://partclone.org
Usage: partclone.extfs [OPTIONS]
    Efficiently clone to a image, device or standard output.

    -o,  --output FILE      Output FILE
    -O   --overwrite FILE   Output FILE, overwriting if exists
         --restore_row_file create special row file for loop device
    -s,  --source FILE      Source FILE
    -L,  --logfile FILE     Log FILE
    -c,  --clone            Save to the special image format
    -r,  --restore          Restore from the special image format
    -b,  --dev-to-dev       Local device to device copy mode
    -D,  --domain           Create ddrescue domain log from source device
         --offset_domain=X  Add offset X (bytes) to domain log values
    -R,  --rescue           Continue after disk read errors
    -dX, --debug=X          Set the debug level to X = [0|1|2]
    -C,  --no_check         Don''t check device size and free space
    -X,  --dialog           Output message as Dialog Format
    -I,  --ignore_fschk     Ignore filesystem check
         --ignore_crc       Ignore crc check error
    -F,  --force            Force progress
    -f,  --UI-fresh         Fresh times of progress
    -m,  --max_block_cache  The used block will be cache until max number
    -q,  --quiet                 Disable progress message
    -v,  --version          Display partclone version
    -h,  --help             Display this help


root:/# partclone.restore --help
partclone.restore v0.2.24 http://partclone.org
Usage: partclone.restore [OPTIONS]
    Efficiently clone to a image, device or standard output.

    -o,  --output FILE      Output FILE
    -O   --overwrite FILE   Output FILE, overwriting if exists
         --restore_row_file create special row file for loop device
    -s,  --source FILE      Source FILE
    -L,  --logfile FILE     Log FILE
    -dX, --debug=X          Set the debug level to X = [0|1|2]
    -C,  --no_check         Don''t check device size and free space
    -X,  --dialog           Output message as Dialog Format
    -I,  --ignore_fschk     Ignore filesystem check
         --ignore_crc       Ignore crc check error
    -F,  --force            Force progress
    -f,  --UI-fresh         Fresh times of progress
    -m,  --max_block_cache  The used block will be cache until max number
    -q,  --quiet                 Disable progress message
    -v,  --version          Display partclone version
    -h,  --help             Display this help



# fsarchiver archinfo sda1.fsa
====================== archive information ======================
Archive type:                   filesystems
Filesystems count:              1
Archive id:                     5681fab4
Archive file format:            FsArCh_002
Archive created with:           0.6.19
Archive creation date:          2015-12-28_13-13-22
Archive label:                  <none>
Minimum fsarchiver version:     0.6.4.0
Compression level:              4 (gzip level 9)
Encryption algorithm:           none

===================== filesystem information ====================
Filesystem id in archive:       0
Filesystem format:              ntfs
Filesystem label:               <unknown>
Filesystem uuid:                5264515364513B45
Original device:                /dev/sdb1
Original filesystem size:       60.00 GB (64422408192 bytes)
Space used in filesystem:       21.95 GB (23566163968 bytes)




# Didn't work...
#
sub Write_NTFS_BS
{
    my($Dev) = shift || '';
    my($pD) = shift || '';

    $Dev =~s/^\/dev\///;

    return unless($Dev && $pD);

    LOG("WNTFS_BS> Making [/dev/$Dev] boot the NTFS way\n");

    my $D;
    foreach(@{ $pD })
    {
	if($_->{Dev} eq $Dev)
	{
	    $D = $_;
	}
    }
    unless(defined($D))
    {
	LOG("WNTFS_BS> No info about [/dev/$Dev]. Return.\n");
	return;
    }

    # The now-usual number of heads problem...
    # We've got the right number, not the one from the BIOS as read
    # by 2.6s kernel, but the one found in the first p.table, and
    # almost certainly credible for having worked.
    #
    LOG("WNTFS_BS> * Let's set the supposedly right number of heads\n");
    LOG("WNTFS_BS>   Should probably be [".$D->{Heads}."]\n");

    # Known to work... though deprecated
    #
    my $cmd = "echo bios_head:".$D->{Heads}." >/proc/ide/$Dev/settings";
    Exec_Log($cmd, 0, "WNTFS_BS>   ");
    Synchronize_Device($Dev);

    # Doesn't seem to work fine
    #
    $cmd = "cd $TMPDIR; testdisk /log /cmd /dev/$Dev"
	." partition_i386,geometry,H,".$D->{Heads};
    LOG("WNTFS_BS>   Cmd: [$cmd]\n");
    system($cmd);
    if(-e "$TMPDIR/testdisk.log")
    {
	LOG("WNTFS_BS>   Testdisk log:\n");
	open(L, "$TMPDIR/testdisk.log");
	while(<L>)
	{
	    s/\s*$//;
	    LOG("WNTFS_BS>     $_\n");
	}
	close(L);
	unlink("$TMPDIR/testdisk.log");
    }

    # Rewrite the MBR
    #
    LOG("WNTFS_BS> * New MBR\n");
    $cmd = "cd $TMPDIR; echo -e \"y\\ny\"|testdisk /log /cmd /dev/"
	."$Dev partition_i386,mbr_code";
    LOG("WNTFS_BS>   Cmd: [$cmd]\n");
    system($cmd);
    if(-e "$TMPDIR/testdisk.log")
    {
	LOG("WNTFS_BS>   Testdisk log:\n");
	open(L, "$TMPDIR/testdisk.log");
	while(<L>)
	{
	    s/\s*$//;
	    LOG("WNTFS_BS>     $_\n");
	}
	close(L);
	unlink("$TMPDIR/testdisk.log");
    }

    # Rewrite the boot sector itself
    #
    LOG("WNTFS_BS> * New bootsector\n");
    $cmd = "cd $TMPDIR; testdisk /log /cmd /dev/$Dev"
	." partition_i386,advanced,boot,rebuildbs";
    LOG("WNTFS_BS>   Cmd: [$cmd]\n");
    system($cmd);
    if(-e "$TMPDIR/testdisk.log")
    {
	LOG("WNTFS_BS>   Testdisk log:\n");
	open(L, "$TMPDIR/testdisk.log");
	while(<L>)
	{
	    s/\s*$//;
	    LOG("WNTFS_BS>     $_\n");
	}
	close(L);
	unlink("$TMPDIR/testdisk.log");
    }

    # And mirror the MFT
    #
    LOG("WNTFS_BS> * Mirroring \$MFT again\n");
    $cmd = "cd $TMPDIR; echo y|testdisk /log /cmd /dev/$Dev"
	." partition_i386,advanced,boot,repairmft";
    LOG("WNTFS_BS>   Cmd: [$cmd]\n");
    system($cmd);
    if(-e "$TMPDIR/testdisk.log")
    {
	LOG("WNTFS_BS>   Testdisk log:\n");
	open(L, "$TMPDIR/testdisk.log");
	while(<L>)
	{
	    s/\s*$//;
	    LOG("WNTFS_BS>     $_\n");
	}
	close(L);
	unlink("$TMPDIR/testdisk.log");
    }

    # Sync just in case
    #
    LOG("WNTFS_BS> * Syncing the p.table just in case\n");
    Synchronize_Device($Dev);

    # Clean up the mess
    #
    LOG("WNTFS_BS> * Must fix each NTFS partition contained in the device\n");
    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
    {
	if(Is_NTFS($D->{Types}->[$i]) && $D->{Parts}->[$i] ne 'null')
	{
	    my $cmd = "ntfsfix /dev/".$D->{Parts}->[$i];
	    Exec_Log($cmd, 0, "WNTFS_BS>   ");
	}
    }

    LOG("WNTFS_BS> Should be OK\n");
    return();
}



# Writes a NTFS boot sector. Well, tries to.
#
# Syntax: Write_NTFS_BS("/dev/hda", \@Dev_Rich);
#
sub STILLBAD_______Write_NTFS_BS
{
    my($Dev) = shift || '';
    my($pD) = shift || '';

    $Dev =~s/^\/dev\///;

    return unless($Dev && $pD);

    my $MNT = "/mnt/WNTFSBS_$$";
    if(-e $MNT)
    {
	system("rm -fr $MNT");
    }
    mkdir($MNT, 0755);

    LOG("WNTFSBS> Called on device [$Dev]\n");


    # Keep hardware info
    #
    LOG("WNTFSBS> * Find out hardware info of dev [$Dev]\n");

    my $Sectors_Track = 0;
    my $Heads = 0;
    foreach my $D (@{ $pD })
    {
	if($D->{Dev} eq $Dev)
	{
	    $Sectors_Track = $D->{Sectors_Track};
	    $Heads = $D->{Heads};
	}
    }

    LOG("WNTFSBS>   Sectors/Track: [$Sectors_Track]\n");
    LOG("WNTFSBS>   Nb of heads: [$Heads]\n");


    # We need a place to store a 40-MB file so to format it FAT32,
    # for the sole purpose to get the number of sectors per fat.
    #
    LOG("WNTFSBS>   * Finding out the number of sectors per fat\n");

    my($Writable_Part) = "";

  loop:
    foreach my $D (@{ $pD })
    {
	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    if($D->{Parts}->[$i] eq 'null')
	    {
		next;
	    }

	    LOG("WNTFSBS>     Device [".$D->{Dev}."], Part [$i]\n");
	    my $Dev_Size = $D->{Heads} * $D->{Sectors_Track} *
		$D->{Cylinders} * 512;

	    LOG("WNTFSBS>       Size of the device: [$Dev_Size]\n");

	    my $Used_Space = Used_Space($D->{Parts}->[$i], 0);
	    LOG("WNTFSBS>       Space used: [$Used_Space]\n");

	    my $Avail_Space = $Dev_Size - $Used_Space;
	    LOG("WNTFSBS>       Available space: [$Avail_Space]\n");

	    if($Avail_Space > 40000000 && Is_Mountable($D->{Parts}->[$i]))
	    {
		$Writable_Part = "/dev/".$D->{Parts}->[$i];
		last loop;
	    }
	}
    }

    if($Writable_Part)
    {
	Mount($Writable_Part, $MNT, "RW");
    }

    Exec_Log("dd if=/dev/zero of=$MNT/fakefat$$ bs=40000 count=1000",
	     0, "WNTFSBS>       ");
    Exec_Log("mkfs.vfat -F 32 $MNT/fakefat$$", 0, "WNTFSBS>       ");
    Exec_Log("cd $TMPDIR; dd if=$MNT/fakefat$$ of=linux.fat.bs count=16 bs=512",
	     0, "WNTFSBS>       ");

    my(@Nb_Sect_per_FAT) = ();
    {
	my $byteCount = 0;
	open(LNX, "< $TMPDIR/linux.fat.bs_");
	binmode(LNX);
	while(read(LNX, $b, 1))
	{
	    if($byteCount >= 36 && $byteCount <= 39)
	    {
		push(@Nb_Sect_per_FAT, $b);
	    }
	    ++ $byteCount;
	}
	close(LNX);
    }

    if(-e "$TMPDIR/linux.fat.bs")
    {
	unlink("$TMPDIR/linux.fat.bs");
    }
    if(-e "$MNT/fakefat$$")
    {
	unlink("$MNT/fakefat$$");
    }

    LOG("WNTFSBS>       Found:\n");
    foreach(@Nb_Sect_per_FAT)
    {
	LOG("WNTFSBS>         [$_]\n");
    }

    Umount($MNT);


    # Finding out the partition that is supposed to be booted
    #
    LOG("WNTFSBS> * Finding out which part will have to boot\n");

    my $To_Boot = '';
    my $Size_To_Boot = 0;

  loop:
    foreach my $D (@{ $pD })
    {
	for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	{
	    if($D->{Parts}->[$i] eq 'null')
	    {
		next;
	    }
	    if($D->{Boot_Flags}->[$i])
	    {
		$To_Boot = "/dev/".$D->{Parts}->[$i];
		$Size_To_Boot = $D->{Blocks}->[$i] / 512 * 1024;
		last loop;
	    }
	}
    }

    LOG("WNTFSBS>   Will have to make [$To_Boot] boot\n");
    LOG("WNTFSBS>   Its size is [$Size_To_Boot]\n");


    # First the MBR
    #
    LOG("WNTFSBS> * Creating the MBR\n");
    Exec_Log("dd if=$PING_DIR/MBR.NTFS of=/dev/$Dev", 0, "WNTFSBS>   ");


    # Now we should have all needed info and be able to write the BS
    #
    LOG("WNTFSBS> * Creating the bootsector\n");

    my $byteCount = 0;

    open(IN, "< $PING_DIR/BS.NTFS");
    binmode(IN);
    open(OUT, "> $TMPDIR/out.bs");

    binmode(OUT);
    while(read(IN, $b, 1))
    {
	# 0Dh => 08 instead of 10 ??
	#
	#if($byteCount == 13)
	#{
	#    print(OUT substr(pack("i", 8), 0, 1));
	#}

	# 18h => nb of sectors by track
	#
	if($byteCount == 24)
	{
	    my $tmp = sprintf("%x", $Sectors_Track);
	    while(length($tmp) < 4)
	    {
		$tmp = "0$tmp";
	    }
	    LOG("WNTFSBS>   Nb_Sect: will write [$tmp]\n");
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 2, 2)))), 0, 1));
	}
	elsif($byteCount == 25)
	{
	    my $tmp = sprintf("%x", $Sectors_Track);
	    while(length($tmp) < 4)
	    {
		$tmp = "0$tmp";
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 0, 2)))), 0, 1));
	}

	# 1Ah => nb of heads
	#
	elsif($byteCount == 26)
	{
	    my $tmp = sprintf("%x", $Heads);
	    while(length($tmp) < 4)
	    {
		$tmp = "0$tmp";
	    }
	    LOG("WNTFSBS>   Nb_Heads: will write [$tmp]\n");
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 2, 2)))), 0, 1));
	}
	elsif($byteCount == 27)
	{
	    my $tmp = sprintf("%x", $Heads);
	    while(length($tmp) < 4)
	    {
		$tmp = "0$tmp";
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 0, 2)))), 0, 1));
	}

	# 20h => Nb of blocks of boot sector's partition (hda1)
	#
	elsif($byteCount == 32)
	{
	    my $tmp = sprintf("%x", $Size_To_Boot);
	    while(length($tmp) < 8)
	    {
		$tmp = "0$tmp";
	    }
	    LOG("WNTFSBS>   Size_To_Boot: will write [$tmp]\n");
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 6, 2)))), 0, 1));
	}
	elsif($byteCount == 33)
	{
	    my $tmp = sprintf("%x", $Size_To_Boot);
	    while(length($tmp) < 8)
	    {
		$tmp = "0$tmp";
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 4, 2)))), 0, 1));
	}
	elsif($byteCount == 34)
	{
	    my $tmp = sprintf("%x", $Size_To_Boot);
	    while(length($tmp) < 8)
	    {
		$tmp = "0$tmp";
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 2, 2)))), 0, 1));
	}
	elsif($byteCount == 35)
	{
	    my $tmp = sprintf("%x", $Size_To_Boot);
	    while(length($tmp) < 8)
	    {
		$tmp = "0$tmp";
	    }
	    print(OUT substr(pack("i", sprintf("%d", hex(substr($tmp, 0, 2)))), 0, 1));
	}
    
	# 26h => Nb of sectors per FAT
	#
	elsif($byteCount >= 36 && $byteCount <= 39)
	{
	    LOG("WNTFSBS>     Nb_Sect_per_FAT[".($byteCount - 36)."]\n");
	    print(OUT $Nb_Sect_per_FAT[$byteCount - 36]);
	}

	else
	{
	    print(OUT $b);
	}

	$by