#!/usr/bin/perl -w
use strict;

#
# Partimage Is Not Ghost / rc.ping
#
# Copyright(c) 2005-2006-2007 Windowsdream.com, GNU Licence
# Home page: PING (Partimage 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 Natan 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.
#

my $MYSELF = "rc.ping";
my $VERSION = "2.01.14";
my $VERSION_DATE = "2008-08-01";
my $VERSION_LINUX = `uname -s -n -r -m -p -i -o`;
$VERSION_LINUX =~s/\s*$//;

my %P = ();

my $TIP_SLEEP = 2;
my $PARTIMAGE_SLEEP = 2;
my $README_SLEEP = 7;
my $DD_SPLIT = 660600000;
my $PARTIMAGE_SPLIT = 630;
my $ZSPLIT_SPLIT = 630;


# Preliminaries
#
unless(-d "/tmp")
{
    mkdir("/tmp", 1777);
}
if(-e "/tmp/x.log")
{
    unlink("/tmp/x.log");
}

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


# See whether we've got Captive-NTFS or NTFS-3G.
# Captive-NTFS might be preferred, because it can handle compressed
# folders better, but new releases of PING will deliver NTFS-3G only.
#
LOG("* How will we mount NTFS partitions in read/write mode ?\n");

my $NTFS_CAP = "";
my $NTFS_MNT = "";
my $NTFS_MNT_TYPE = "";
my $NTFS_MNT_OPTIONS = "";

if(-d "/var/lib/captive")
{
    $NTFS_CAP = "echo d|captive-install-acquire >/dev/null 2>&1";
    $NTFS_MNT = "echo d|captive-install-acquire >/dev/null 2>&1; mount -t captive-ntfs";
    $NTFS_MNT_TYPE = "captive-ntfs";
    LOG("  With Captive-NTFS!\n");
}
else
{
    $NTFS_MNT_OPTIONS = "-o force";
    $NTFS_MNT = "mount $NTFS_MNT_OPTIONS -t ntfs-3g";
    $NTFS_MNT_TYPE = "ntfs-3g";
    LOG("  With NTFS-3G!\n");
}


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

{
    my $flag = 0;

    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", "No_Shell",
			  "AUTO", "Cmd_1", "Cmd_2", "Cmd_3", "Restore_Only",
			  "Compression_Type");

    if(-e "/etc/ping.conf")
    {
	LOG("  Found a [/etc/ping.conf] file.\n");

	open(DB, "/etc/ping.conf");
	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(@Config_Fields)
	    {
		if(lc($_) eq lc($f[0]))
		{
		    $P{$_} = $V;
		    $flag = 1;
		}
	    }
	}
	close(DB);

	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("  Found: [$_] = [".((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);
    }
}


# The source.
#
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*$//;
	my $cmd = "insmod $_ 2>&1";
	LOG("  Cmd: [$cmd]\n");
	my $out = `$cmd`;
	LOG("  Output: [$out]\n");
    }
}


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

my $CD_Dev = '';
{
    my $nb = 0;
    foreach my $d ("hda", "hdb", "hdc", "hdd", "sda", "sdb", "sdc", "sr0")
    {
        system("umount /mnt/cdrom >/dev/null 2>&1");
        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[abcde]$/)
		{
                    LOG("  Found a [/mnt/cdrom/$F] file\n");
		    $CD_Dev = $d;
                    $SRC = "/mnt/cdrom";
		    LOG("  Linking [/dev/cdrom] to [/dev/$d]\n");
		    system("rm -f /dev/cdrom; ln -sf /dev/$d /dev/cdrom");
                }
            }
            sleep(5);   # Blink & start up.
            last;
        }
    }
    unless($nb)
    {
        LOG("  No CDRom device or media was found.\n");
    }
}


# If addon*.tar.gz 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/i)
	{
	    LOG("  Addon found! [$_]\n");
	    my $cmd = "cd /; tar xvfz /mnt/cdrom/$_";
	    LOG("    Cmd: [$cmd]\n");
	    system($cmd);
	}
    }
}


# 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 avoid 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
#
if(defined($P{No_Shell}))
{
    if($P{No_Shell} =~/^(y|1)$/i)
    {
	$P{No_Shell} = 1;
    }
    else
    {
	$P{No_Shell} = 0;
    }
}
else
{
    $P{No_Shell} = 0;
}

if(defined($P{Restore_Only}))
{
    if($P{Restore_Only} =~/^(y|1)$/i)
    {
	$P{Restore_Only} = 1;
    }
    else
    {
	$P{Restore_Only} = 0;
    }
}
else
{
    $P{Restore_Only} = 0;
}

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


# Give the user a chance to avoid this script.
#
system("clear");
print "\n$VERSION_LINUX\n";
print "\n***     PING (Partimage Is Not Ghost) -- $VERSION $VERSION_DATE     ***\n";
print "***         Get doc and latest release on PING website          ***\n";
print "***                http://ping.windowsdream.com/                ***\n";
unless($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>> ";


# 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 && ! $P{No_Shell})
    {
	print "To have several terms, get a shell and launch /etc/rc.d/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: mount -t $NTFS_MNT_TYPE /dev/sda1 /mnt/dos\n";
	if($NTFS_MNT_TYPE =~/captive/i)
	{
	    print "  Note: You'll have to type the mount command twice.\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 -t smbfs //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";
	print "\n>> ";
	$Grab = <STDIN>;
    }
    if($Grab =~/^skip/i)
    {
#:::
    }
    if($Grab =~/^x/i && ! $P{No_Shell})
    {
	exit;
    }
}


# 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', 'sda', 'sdb', 'hdc', 'hdd', 'sdc', 'sdd');
    #
    # 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);
	}
    }

    foreach(@AllDevices)
    {
	# At least thanks to udev, we won't have too many tries!
	#
	if(-e "/dev/$_")
	{
#	    LOG("  - Checking [/dev/$_]...\n");
	    my $out = `echo |fdisk /dev/$_ 2>&1`;
	    $out =~s/^\s*//;
	    $out =~s/\s*$//;
#	    LOG("    [$out]\n");
	    #
	    # Either not a partition at all, either is a CDRom = bad cases
	    #
	    if($out !~/^unable to open/i && $out !~/you will not be able to write/i)
	    {
		push(@Dev, $_);
	    }
	} 
    }
}
foreach(@Dev)
{
    LOG("  => HDD device found: [$_]\n");
    sleep(1);
}
if($#Dev < 0)
{
    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.\n");
    sleep(5);
    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) = ();

# Will have to handle LVM devices...
#
{
    LOG("  Preparing to handle possibly LVM devices\n");
    my $cmd = "vgchange -ay";
    LOG("    Cmd: [$cmd]\n");
    my $out = `$cmd`;
    LOG("    Output: [$out]\n");
}

foreach my $D (@Dev)
{
    LOG("  Device [$D]\n");

    # Device geometry according to fdisk
    #
    my $Dev_Heads = 0;
    my $Dev_Sectors_Track = 0;
    my $Dev_Cylinders = 0;
    {
	my $tmp = `sfdisk -G /dev/$D`;
	$tmp =~s/^\s*//;
	$tmp =~s/\s*$//;
	if($tmp =~/(\d+)\s+cylinders/i)
	{
	    $Dev_Cylinders = $1;
	}
	if($tmp =~/(\d+)\s+heads/i)
	{
	    $Dev_Heads = $1;
	}
	if($tmp =~/(\d+)\s+sectors/i)
	{
	    $Dev_Sectors_Track = $1;
	}
    }

    # 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 $tmp = `sfdisk -g /dev/$D`;
	$tmp =~s/^\s*//;
	$tmp =~s/\s*$//;
	if($tmp =~/(\d+)\s+cylinders/i)
	{
	    $BIOS_Cylinders = $1;
	}
	if($tmp =~/(\d+)\s+heads/i)
	{
	    $BIOS_Heads = $1;
	}
	if($tmp =~/(\d+)\s+sectors/i)
	{
	    $BIOS_Sectors_Track = $1;
	}
    }

    my(@Parts) = ();
    my(@Types) = ();
    my(@Dirs) = ();
    my(@Labels) = ();
    my(@Boot_Flags) = ();
    my(@Start) = ();
    my(@End) = ();
    my(@Blocks) = ();

    `fdisk -l /dev/$D >/tmp/bla`;
    if(-e "/tmp/bla")
    {
	open(DB, "/tmp/bla");
	while(<DB>)
	{
	    s/^\s*//;
	    s/\s*$//;
	    if(m/^\/dev\/$D/i)
	    {
		if(m/\*/)
		{
		    s/\*//g;    # Boot flag
		    push(@Boot_Flags, 1);
		}
		else
		{
		    push(@Boot_Flags, 0);
		}
		s/  / /g while(m/  /);
		s/^\s*\/dev\///i;
		my(@F) = split(/ /, $_);
		push(@Parts, $F[0]);
		for(1..3)
		{
		    $F[$_] =~s/\D//g;
		}
		push(@Start, $F[1]);
		push(@End, $F[2]);
		push(@Blocks, $F[3]);
		push(@Types, $F[4]);
	    }
	}
	close(DB);
	unlink("/tmp/bla");
    }

    # 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).
    #
    {
	my $cmd = "lvscan";
	LOG("    Cmd: [$cmd]\n");
	my $out = `$cmd`;
	LOG("    Output: [$out]\n");
	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\///;
		my(@f) = split(/\//, $Part);
		push(@Parts, "mapper/$f[0]-$f[1]");
		LOG("    Found LVM: [/dev/$Part] =>[/dev/$Parts[-1]]\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("    Is [/dev/$Parts[-1]] a linux swap ?\n");
		if(Is_Swap("/dev/$Parts[-1]"))
		{
		    LOG("      It's a linux swap.\n");
		    push(@Types, "82");
		}
		else
		{
		    LOG("      It's not.\n");
		    push(@Types, '');
		}
	    }
	}
    }

    for(my $i = 0; $i <= $#Parts; $i++)
    {
	LOG("    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).
	#
	if(Is_NTFS($Types[$i]))
	{
	    system("umount /mnt/dos >/dev/null 2>&1;"
		   ."mount -t $NTFS_MNT_TYPE /dev/$Parts[$i]"
		   ." /mnt/dos >/dev/null 2>&1");
	}
	else
	{
	    system("umount /mnt/dos >/dev/null 2>&1;"
		   ."mount /dev/$Parts[$i] /mnt/dos >/dev/null 2>&1");
	}

	if(Is_Mounted("/dev/$Parts[$i]"))
	{
	    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));
	    system("umount /mnt/dos >/dev/null 2>&1");

	    LOG("      Found directories: [".join(', ', @R)."]\n");
	}
	else
	{
	    LOG("      This part could not be mounted.\n");
	    if(Is_NTFS($Types[$i]))
	    {
		LOG("      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.
		#
		if($NTFS_MNT_TYPE eq "ntfs-3g")
		{
		    LOG("      Maybe we can mount it Read Only ?\n");
		    system("umount /mnt/dos >/dev/null 2>&1;"
			   ."mount -o ro -t $NTFS_MNT_TYPE /dev/$Parts[$i]"
			   ." /mnt/dos >/dev/null 2>&1");
		    if(Is_Mounted("/dev/$Parts[$i]"))
		    {
			LOG("        Mounted. Let's tell the user.\n");
			LOG("\n");
			LOG("!!! It seems that your partition [/dev/$Parts[$i]]\n");
			LOG("    can only be mounted in Read Only. This is generally\n");
			LOG("    a sign that Windows has not been shut down properly\n");
			LOG("    or is in hibernation mode. We are going to proceed,\n");
			LOG("    but we won't be able to write data on this partiton.\n");
			LOG("    Please reboot now and clear this point if necessary.\n");
			LOG("    Sleeping $README_SLEEP seconds.\n");
			sleep($README_SLEEP);
		    }
		}
		LOG("      Maybe a Windows RAID... proceed.\n");
		push(@Dirs, 'unavailable');
	    }
	    else
	    {
		LOG("      And it's not NTFS. Next!\n");
		push(@Dirs, '');
	    }
	}
    }

    # 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{Parts} = \@Parts;
    $Rich{Types} = \@Types;
    $Rich{Dirs} = \@Dirs;
    $Rich{Labels} = \@Labels;
    $Rich{Boot_Flags} = \@Boot_Flags;
    $Rich{Start} = \@Start;
    $Rich{End} = \@End;
    $Rich{Blocks} = \@Blocks;

    push(@Dev_Rich, \%Rich);
}


# Let's recapitulate all our device discovery results...
#
LOG("* Results of device discovery\n");
HDD_Describe();


# 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 (Partimage 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($P{No_Shell})
	{
	    $SH = '"Get a shell (root)" ""';
	}
	my $cmd = 'dialog --colors --menu "\Zb\Z7PING Partimage Is Not Ghost\n\n'
	    .'\ZnWhen the job is completed, do you want to...\n\n" 15 40 3 '
	    .' '.$SH.' "Reboot the system" ""'
	    .' "Shutdown" "" 2>/tmp/checklist.tmp';
	system($cmd);

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

	open(DB, "/tmp/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);
	`rm -f /tmp/checklist.tmp`;
    }
}

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


# As no CD/DVD is involved, the user may choose whether she 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 Server entry in ping.conf => Will be network\n");
    }
    elsif(defined($P{Server}) && $P{Server} =~/^\/dev/)
    {
	LOG("  The user has provided a /dev Server entry in ping.conf =>"
	    ."  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 a ping.conf file => Ask.\n");

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

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

	open(DB, "/tmp/checklist.tmp");
	while(<DB>)
	{
	    if(m/local/i || m/^l/i)
	    {
		$SRC = "local";
		LOG("  Local!\n");
	    }
	    else
	    {
		LOG("  Network!\n");
	    }
	}
	close(DB);
	`rm -f /tmp/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");
	    my $cmd = "ifconfig eth0 down; ifconfig eth0 up; sleep 2; rm -f"
		." /var/run/dhcpcd-eth0.pid; dhcpcd "
		.($P{DHCP_Timeout} ? "-t $P{DHCP_Timeout}":"")." eth0";
	    LOG("    Cmd: [$cmd]\n");
	    system($cmd);

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

		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>/tmp/BLA';
		system($cmd);
		if(-e "/tmp/BLA")
		{
		    open(DB, "/tmp/BLA");
		    while(<DB>)
		    {
			$P{IP} .= $_;
		    }
		    close(DB);
		    unlink("/tmp/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>/tmp/BLA';
		system($cmd);
		if(-e "/tmp/BLA")
		{
		    open(DB, "/tmp/BLA");
		    while(<DB>)
		    {
			$P{Netmask} .= $_;
		    }
		    close(DB);
		    unlink("/tmp/BLA");
		}
	    }

	    unless(defined($P{Gateway}) && $P{Gateway})
	    {
		my $cmd = 'dialog --inputbox "Enter your gateway '
		    .'(eg. 192.168.0.1)" 8 51 2>/tmp/BLA';
		system($cmd);
		if(-e "/tmp/BLA")
		{
		    open(DB, "/tmp/BLA");
		    while(<DB>)
		    {
			$P{Gateway} .= $_;
		    }
		    close(DB);
		    unlink("/tmp/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 $cmd = "ifconfig eth0 down;"
		." ifconfig eth0 $P{IP} netmask $P{Netmask} up;"
		." route add default gw $P{Gateway};"
		." ifconfig eth0 >/tmp/out 2>&1";
	    LOG("      Cmd: [$cmd]\n");
	    system($cmd);

	    ++ $Tries;

	    my $out = "";
	    if(-e "/tmp/out")
	    {
		open(DB, "/tmp/out");
		while(<DB>)
		{
		    $out .= $_;
		    if(m/$P{IP}/)
		    {
			$Tries = 0;
			LOG("      We're connected !\n");
		    }
		}
		close(DB);
		unlink("/tmp/out");
	    }

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

		my $cmd = "ifconfig eth1 down;"
		    ." ifconfig eth1 $P{IP} netmask $P{Netmask} up;"
		    ." route add default gw $P{Gateway};"
		    ." ifconfig eth1 >/tmp/out 2>&1";
		LOG("      Cmd: [$cmd]\n");
		system($cmd);

		++ $Tries;

		my $out = "";
		if(-e "/tmp/out")
		{
		    open(DB, "/tmp/out");
		    while(<DB>)
		    {
			$out .= $_;
			if(m/$P{IP}/)
			{
			    $Tries = 0;
			    LOG("      We're connected !\n");
			}
		    }
		    close(DB);
		    unlink("/tmp/out");
		}
	    }

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

    $SRC = "/mnt/smbfs";
}


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

    if(defined($P{CIFS_Preferred}))
    {
	LOG("  There's a preconfig entry; worth [$P{CIFS_Preferred}]\n");
	if($P{CIFS_Preferred} =~/^(y|1)$/i)
	{
	    $P{CIFS_Preferred} = 1;
	}
	else
	{
	    $P{CIFS_Preferred} = 0;
	}
    }
    else
    {
	LOG("  There's no preconfig predefined info. Asking.\n");
	
	my $cmd = 'dialog --colors --menu "\Zb\ZnWill Samba rather use'
	    .' the SMBFS or the CIFS protocol (say SMBFS if you dunno) ?'
	    .'\n\n" 12 50 2 '
	    .' "CIFS" "" "SMBFS" "" 2>/tmp/checklist.tmp';
	system($cmd);

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

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

	LOG("  =>CIFS_Preferred: [$P{CIFS_Preferred}]\n");
    }
}


# Mount partimages' network share.
#
if($SRC =~/smbfs$/)
{
    # Let's find this directory...
    #
    my $Tries = 1;

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

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

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

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

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

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

	LOG("* Unmounting [/mnt/smbfs]\n");
	my $cmd = "umount /mnt/smbfs >/dev/null 2>&1";
	LOG("  Cmd: [$cmd]\n");
	system($cmd);
	LOG("* Trying to mount [//$P{Server}/$P{Share}] ("
	    .($P{CIFS_Preferred} ? "cifs":"smbfs").")\n");
	$cmd = "mount.".($P{CIFS_Preferred} ? "cifs":"smbfs")
	       ." //$P{Server}/$P{Share} /mnt/smbfs"
	       ." -o username=\"$P{User}\",password=\"$P{Passwd}\""
	       ." >/tmp/out 2>&1";
	{
	    my $tmp = $cmd;
	    $tmp =~s/password=\"$P{Passwd}\"/password=xxx/g;
	    LOG("  Cmd: [$tmp]\n");
	}
	system($cmd);

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

	    if($out =~/failed/i || $out =~/cannot/i || $out =~/missing/i
	       || $out =~/error/i || $out =~/is not a valid/i)
	    {
		# Another chance
		my $tmp = `df |grep smbfs |wc -l`;
		$tmp =~s/\D//g;
		unless($tmp)
		{
		    $Tries = 2;
		    LOG("\n* No success... Trying again (cifs vs. smbfs).\n");
		    sleep(2);
		}
	    }
	    else
	    {
		$Tries = 1;
	    }
	}

	# It has been reported that sometimes, the syntax mount -t xxx //xxx/zzz
	# is not working, while mount -t xxx \\\\xxx\\zzz does. Trying.
	#
	if($Tries != 1)
	{
	    LOG("* Second chance! (".($P{CIFS_Preferred} ? "cifs":"smbfs").")\n");
	    LOG("* Unmounting [/mnt/smbfs]\n");
	    my $cmd = "umount /mnt/smbfs >/dev/null 2>&1";
	    LOG("  Cmd: [$cmd]\n");
	    system($cmd);
	    LOG("* Trying to mount [\\\\$P{Server}\\$P{Share}] ("
		.($P{CIFS_Preferred} ? "cifs":"smbfs").")\n");
	    $cmd = "mount.".($P{CIFS_Preferred} ? "cifs":"smbfs")
		   ." \\\\\\\\$P{Server}\\\\$P{Share} /mnt/smbfs"
		   ." -o username=\"$P{User}\",password=\"$P{Passwd}\""
		   ." >/tmp/out 2>&1";
	    {
		my $tmp = $cmd;
		$tmp =~s/password=\"$P{Passwd}\"/password=xxx/g;
		LOG("  Cmd: [$tmp]\n");
	    }
	    system($cmd);

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

		if($out =~/failed/i || $out =~/cannot/i || $out =~/missing/i
		   || $out =~/error/i || $out =~/is not a valid/i)
		{
		    # Another chance
		    my $tmp = `df |grep smbfs |wc -l`;
		    $tmp =~s/\D//g;
		    unless($tmp)
		    {
			$Tries = 2;
			LOG("\n* No success... Trying again (cifs vs. smbfs).\n");
			sleep(2);
		    }
		}
		else
		{
		    $Tries = 1;
		}
	    }
	}

	# Sometimes, smbfs must be preferred to cifs (or vice versa)
	# Let's give it a chance.
	#
	if($Tries != 1)
	{
	    LOG("* Third chance! (".($P{CIFS_Preferred} ? "smbfs":"cifs").")\n");
	    LOG("* Unmounting [/mnt/smbfs]\n");
	    my $cmd = "umount /mnt/smbfs >/dev/null 2>&1";
	    LOG("  Cmd: [$cmd]\n");
	    system($cmd);
	    LOG("* Trying to mount [//$P{Server}/$P{Share}] ("
		.($P{CIFS_Preferred} ? "smbfs":"cifs").")\n");
	    $cmd = "mount.".($P{CIFS_Preferred} ? "smbfs":"cifs")
		   ." //$P{Server}/$P{Share} /mnt/smbfs"
		   ." -o username=\"$P{User}\",password=\"$P{Passwd}\""
		   ." >/tmp/out 2>&1";
	    {
		my $tmp = $cmd;
		$tmp =~s/password=\"$P{Passwd}\"/password=xxx/g;
		LOG("  Cmd: [$tmp]\n");
	    }
	    system($cmd);

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

		if($out =~/failed/i || $out =~/cannot/i || $out =~/missing/i
		   || $out =~/error/i || $out =~/is not a valid/i)
		{
		    # Another chance
		    my $tmp = `df |grep smbfs |wc -l`;
		    $tmp =~s/\D//g;
		    unless($tmp)
		    {
			$Tries = 2;
			LOG("\n* No success... Trying again (another syntax).\n");
			sleep(2);
		    }
		}
		else
		{
		    $Tries = 1;
		}
	    }
	}

	# Same \\\\xxx\\yyy syntax, inversing smbfs and cifs.
	#
	if($Tries != 1)
	{
	    LOG("* Fourth chance! (".($P{CIFS_Preferred} ? "smbfs":"cifs").")\n");
	    LOG("* Unmounting [/mnt/smbfs]\n");
	    my $cmd = "umount /mnt/smbfs >/dev/null 2>&1";
	    LOG("  Cmd: [$cmd]\n");
	    system($cmd);
	    LOG("* Trying to mount [\\\\$P{Server}\\$P{Share}] ("
		.($P{CIFS_Preferred} ? "smbfs":"cifs").")\n");
	    $cmd = "mount.".($P{CIFS_Preferred} ? "smbfs":"cifs")
		   ." \\\\\\\\$P{Server}\\\\$P{Share} /mnt/smbfs"
		   ." -o username=\"$P{User}\",password=\"$P{Passwd}\""
		   ." >/tmp/out 2>&1";
	    {
		my $tmp = $cmd;
		$tmp =~s/password=\"$P{Passwd}\"/password=xxx/g;
		LOG("  Cmd: [$tmp]\n");
	    }
	    system($cmd);

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

		if($out =~/failed/i || $out =~/cannot/i || $out =~/missing/i
		   || $out =~/error/i || $out =~/is not a valid/i)
		{
		    # Another chance
		    my $tmp = `df |grep smbfs |wc -l`;
		    $tmp =~s/\D//g;
		    unless($tmp)
		    {
			$Tries = 2;
			LOG("\n* Well, BAD Server, Share, User or Passwd."
			    ." TRY AGAIN.\n");
			sleep(5);
		    }
		}
		else
		{
		    $Tries = 1;
		}
	    }
	}

	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\Partimage)" 8 51 2>/tmp/BLA';
		system($cmd);
		$P{Directory} = '';
		if(-e "/tmp/BLA")
		{
		    open(DB, "/tmp/BLA");
		    while(<DB>)
		    {
			$P{Directory} .= $_;
		    }
		    close(DB);
		    unlink("/tmp/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 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/i)
	    {
		LOG("  Addon found! [$_]\n");
		my $cmd = "cd /; tar xvfz \"/mnt/smbfs/$P{Directory}/$_\"";
		LOG("    Cmd: [$cmd]\n");
		system($cmd);
	    }
	}
    }
}


# 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 $Only_One_Part = 0;
my $New_Second_Part = 0;

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

    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");

	++ $Only_One_Part;

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

	my $Dev_Size = 0;
	my $Dev_Type = 0;

	my $cmd = "fdisk -l /dev/".$Dev_Rich[0]->{Dev}." >/tmp/bla";
	LOG("    Cmd: [$cmd]\n");
	system($cmd);
	if(-e "/tmp/bla")
	{
	    open(DB, "/tmp/bla");
	    while(<DB>)
	    {
		my $tmp = $Dev_Rich[0]->{Parts}->[0];
		if(m/^\/dev\/$tmp/i && ! $Dev_Size)
		{
		    $Dev_Size = $_;
		    $Dev_Size =~s/\*//g;
		    $Dev_Size =~s/\+//g;
		    $Dev_Size =~s/\s+/ /g;
		    $Dev_Size = (split(/ /, $Dev_Size))[3] * 1024;
		}
		if(m/^\/dev\/$tmp/i && ! $Dev_Type)
		{
		    $Dev_Type = $_;
		    $Dev_Type =~s/\*//g;
		    $Dev_Type =~s/\s+/ /g;
		    $Dev_Type = (split(/ /, $Dev_Type))[4];
		}
	    }
	    close(DB);
	    unlink("/tmp/bla");
	}

	LOG("  - Size of the device: [$Dev_Size]\n");
	LOG("  - Type of the unique part: [$Dev_Type]\n");

	if(Is_NTFS($Dev_Rich[0]->{Types}->[0]))
	{
	    system("umount /mnt/dos >/dev/null 2>&1; "
		   ."mount -t $NTFS_MNT_TYPE /dev/".$Dev_Rich[0]->{Parts}->[0]
		   ." /mnt/dos >/dev/null 2>&1");
	}
	else
	{
	    system("umount /mnt/dos >/dev/null 2>&1; "
		   ."mount /dev/".$Dev_Rich[0]->{Parts}->[0]
		   ." /mnt/dos >/dev/null 2>&1");
	}

	my $Used_Space = 0;
	my $out = `df 2>&1 | grep -i \/dev\/$Dev_Rich[0]->{Parts}->[0]`;
	$out =~s/\s+/ /g;
	$Used_Space = (split(/ /, $out))[2] * 1024;
	LOG("  - Space used by [".$Dev_Rich[0]->{Parts}->[0]."]: [$Used_Space]\n");

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

	my $Useless_Space = 0;

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

	    foreach my $file ("pagefile.sys", "hiberfil.sys")
	    {
		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");
	    }
	}

	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\n(You definitely SHOULD have a backup of any valuable data'
		    .' before saying Yes here.)\n\n" 19 50 2 '
		    .' "Yes" "" "No" "" 2>/tmp/checklist.tmp';
		system($cmd);

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

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

	    unless($Resize)
	    {
		LOG("  Wisdom has been chosen... exit is the only choice.\n");
		sleep(5);
		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");

		if(Is_NTFS($Dev_Type))
		{
		    LOG("    Mounting with $NTFS_MNT_TYPE [/dev/"
			.$Dev_Rich[0]->{Parts}->[0]."]\n");
		    system("umount /mnt/dos >/dev/null 2>&1;"
			   ." $NTFS_MNT /dev/".$Dev_Rich[0]->{Parts}->[0]
			   ." /mnt/dos >/dev/null 2>&1;"
			   ." umount /mnt/dos >/dev/null 2>&1;"
			   ." mount $NTFS_MNT_OPTIONS -t $NTFS_MNT_TYPE /dev/"
			   .$Dev_Rich[0]->{Parts}->[0]." /mnt/dos");
		}

		foreach my $file ("pagefile.sys", "hiberfil.sys")
		{
		    if(-e "/mnt/dos/$file")
		    {
			system("cd /mnt/dos; chmod 666 $file >/dev/null 2>&1;"
			       ."rm -f $file >/dev/null 2>&1; sync");
			LOG("    Deleting [/mnt/dos/$file]\n");
		    }
		}
	    }

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

	    my $New_Size = 0;
	    {
		system("umount /mnt/dos >/dev/null 2>&1");
		system("echo y|ntfsresize -i -f /dev/".$Dev_Rich[0]->{Parts}->[0]
		       ." >/tmp/bla 2>&1");
		if(-e "/tmp/bla")
		{
		    open(DB, "/tmp/bla");
		    while(<DB>)
		    {
			if(m/^You might resize at/i)
			{
			    $New_Size = $_;
			    $New_Size =~s/^\D+([0-9]+)\sbytes.*$/$1/;
			    $New_Size =~s/\D//g;
			    LOG("    We can reduce to [$New_Size]\n");
			    last;
			}
		    }
		    close(DB);
		    unlink("/tmp/bla");
		}

		# Not too much, yet.
		#
		if($New_Size < .5 * $Dev_Size)
		{
		    $New_Size = int($Dev_Size / 2);
		    LOG("    Reducing to [$New_Size] 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]\n");
		}

		if($Used_Space > $New_Size || $New_Size == 0)
		{
		    LOG("    !!! Space problem. Aborting now.\n");
		    sleep(5);
		    Quit();
		}
	    }
	    
	    if($New_Size)
	    {
		LOG("  - Resizing to [$New_Size] !!\n");
		{
		    my $cmd = "echo y|ntfsresize -f -s $New_Size /dev/"
			.$Dev_Rich[0]->{Parts}->[0]." 2>&1";
		    LOG("    Cmd: [$cmd]\n");
		    my $out = `$cmd`;
		    $out =~s/^\s*//;
		    $out =~s/\s*$//;
		    LOG("    Output: [$out]\n");
		    my(@tmp) = ('d', 'n', 'p', '1', '1', '+'.int($New_Size / 1024).'K',
				'a', '1', 't', $Dev_Type, 'w');
		    $cmd = 'echo -e "';
		    foreach(@tmp)
		    {
			$cmd .= $_.'\n';
		    }
		    $cmd .= '" | fdisk /dev/'.$Dev_Rich[0]->{Dev}.' 2>&1';
		    LOG("    Cmd: [$cmd]\n");
		    $out = `$cmd`;
		    $out =~s/^\s*//;
		    $out =~s/\s*$//;
		    LOG("    Output: [$out]\n");
		}
	    }
	    else
	    {
		LOG("  - Won't resize to [$New_Size]... aborting this.\n");
	    }

	    # 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");

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

	    LOG("  - Creating a second partition on [/dev/"
		.$Dev_Rich[0]->{Parts}->[1]."] (FAT32)\n");

	    {
		my(@tmp) = ('n', 'p', '2', '', '', 't', '2', 'c', 'w');
		my $cmd = 'echo -e "';
		foreach(@tmp)
		{
		    $cmd .= $_.'\n';
		}
		$cmd .= '" | fdisk /dev/'.$Dev_Rich[0]->{Dev}.' 2>&1';
		LOG("    Cmd: [$cmd]\n");
		my $out = `$cmd`;
		$out =~s/^\s*//;
		$out =~s/\s*$//;
		LOG("    Output: [$out]\n");
	    }

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

	    {
		my $cmd = "mkfs.vfat -F 32 /dev/".$Dev_Rich[0]->{Parts}->[1];
		LOG("    Cmd: [$cmd]\n");
		my $out = `$cmd`;
		$out =~s/^\s*//;
		$out =~s/\s*$//;
		LOG("    Output: [$out]\n");
	    }

	    @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(5);
	    Quit();
	}
    }
}

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

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

    if($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");

	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. Use'
		.' SPACE to SELECT an entry.\n\n"'
		.' 20 73 7 ';

	    $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++)
		{
		    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>/tmp/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, "/tmp/checklist.tmp");
	    while(<DB>)
	    {
		s/^\s*//;
		s/\s*$//;
		$tmp .= $_;
	    }
	    close(DB);
	    unlink("/tmp/checklist.tmp");

	    @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])
	    {
		LOG("    A restoration has been asked.\n");
		++ $EXIT;
	    }
	    else
	    {
		LOG("    Nb parts to backup: [".($#Parts_To_Backup + 1)."]\n");
		LOG("    Nb 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);
	}
    }
}

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");
		my $cmd = "umount /mnt/dos >/dev/null 2>&1; mount $ldev /mnt/dos";
		LOG("      Cmd: [$cmd]\n");
		system($cmd);
		if(Is_Mounted($ldev))
		{
		    LOG("      [$ldev] is mounted !\n");
		    my $tmp = "/mnt/dos".($P{Directory} ? $P{Directory}:"/");
		    $tmp .= ($tmp =~/\/$/ ? "":"/").$P{Image_To_Restore};
		    LOG("      Any [$tmp] found ?\n");
		    if(-d $tmp)
		    {
			LOG("        Yes! Good!\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 --radiolist "\Zb\Z7Choose the partition'
		.($P{Restore_Only} ? '':' where to store the backup /')
		.' where the backup is stored.\n\n"'
		.' 20 73 7 ';

	    foreach my $D (@Dev_Rich)
	    {
		for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
		{
		    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.'" "" off';
		    }
		}
	    }

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

	    system($cmd);

	    my $tmp = "";
	    open(DB, "/tmp/checklist.tmp");
	    while(<DB>)
	    {
		$tmp .= $_;
	    }
	    close(DB);
	    unlink("/tmp/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");

	    if(Is_NTFS(Part_Type($Part_For_Storage)))
	    {
		$cmd = "umount /mnt/dos >/dev/null 2>&1; "
		    ."mount -t $NTFS_MNT_TYPE /dev/$Part_For_Storage"
		    ." /mnt/dos >/dev/null 2>&1";
	    }
	    else
	    {
		$cmd = "umount /mnt/dos >/dev/null 2>&1; "
		    ."mount /dev/$Part_For_Storage /mnt/dos >/dev/null 2>&1";
	    }
	    system($cmd);

	    $tmp = `df |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(5);
	    }
	}
    }
}

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 /Partimage directory on it.\n");

	my $cmd = "umount $SRC >/dev/null 2>&1;".
	    "mount /dev/$Part_For_Storage $SRC >/dev/null 2>&1;".
	    "mkdir $SRC/Partimage";
	LOG("    Cmd: [$cmd]\n");
	system($cmd);

	$P{Directory} = "/Partimage";
    }
    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\Partimage)" 8 51 2>/tmp/BLA';
		system($cmd);
		$P{Directory} = '';
		if(-e "/tmp/BLA")
		{
		    open(DB, "/tmp/BLA");
		    while(<DB>)
		    {
			$P{Directory} .= $_;
		    }
		    close(DB);
		    unlink("/tmp/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 Entity could be found.\n");
	sleep 5;
        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 ("Blank_Local_Admin_Passwd", "Create_New_Image")
    {
	# 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" && $P{Restore_Only});

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


# 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'
	    .($P{Restore_Only} ? '':'\ZnChoose Create_New_Image if'
	      .' you want a Ghost-like image of your partition(s),'
	      .' choose Backup_Local_Hard_Disk_Drive if you'
	    .' prefer a zip archive.').'" 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.
	    #
	    next if(($_ eq "Create_New_Image" || $_ eq "Backup_Local_Hard_Disk"
		     || $_ eq "Blank_Local_Admin_Passwd") && $P{Restore_Only});

	    $cmd .= '"'.$_.'" "" ';
	}
	$cmd .= ' 2>/tmp/BLA';
	system($cmd);
	if(-e "/tmp/BLA")
	{
	    open(DB, "/tmp/BLA");
	    while(<DB>)
	    {
		$Entity .= $_;
	    }
	    close(DB);
	    unlink("/tmp/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.
# File sda contains partitionning information and must be dumped first.
#
my $Have_Restored = 0;
my $Have_Minimized_Before_Storing = 0;
my(@Minimized_Devices) = ();

if($Entity =~/Partition_and_Format_ANY_Computer/i
   || $Entity =~/Backup_Local_Hard_Disk/i
   || $Entity =~/Blank_Local_Admin_Passwd/i
   || $Entity =~/Create_New_Image/i)
{
    my $Dev = '';
    if($SRC =~/smbfs/i)
    {
	$Dev = (defined($Dev[0])) ? $Dev[0]:'';
    }
    elsif($SRC =~/dos/i)
    {
	$Dev = $Part_For_Storage;
	$Dev =~s/\d+$//;
    }

    if($SRC =~/dos/i && $Dev && $Entity =~/Partition_and_Format_ANY_Computer/i)
    {
        LOG("* Found a HDD device: [/dev/$Dev]\n");

        # Do the partitions job... argh :=-
        #
	LOG("* Create partitions as specified\n");

	opendir(DIR, "$SRC/$Entity");
	my(@files) = readdir(DIR);
	closedir(DIR);
	foreach my $F (@files)
	{
	    if($F =~/^.*\.part$/i)
	    {
		my $Dev = $F;
		$Dev =~s/\.part$//i;
		my $CMD_Label = '';

		LOG("  * Found [$F] => partitioning instructions.\n");
		my @fdisk = ('d', 1, 'd', 2, 'd', 3, 'd', 4, 'd', 5, 'd', 6);
		my $cnt = 0;
		open(DB, "$SRC/$Entity/$F");
		while(<DB>)
		{
		    s/^\s*//;
		    s/\s*$//;
		    s/\s/ /g;
		    while(m/  /)
		    {
			s/  / /g;
		    }
		    next if(m/^\;/);
		    my @fields = split(/ /, $_);
		    next unless($#fields >= 2);
		    my($PNumber, $PSize, $PType, $PLabel, $PBoot) = @fields;

		    push(@fdisk, 'n', 'p', $PNumber, '');
		    if($PSize eq "+")
		    {
			push(@fdisk, '');
		    }
		    else
		    {
			push(@fdisk, "+$PSize");
		    }
		    push(@fdisk, 't');
		    if($cnt > 0)
		    {
			push(@fdisk, $PNumber);
		    }
		    push(@fdisk, $PType);
		    if($PBoot eq "*")
		    {
			push(@fdisk, 'a', $PNumber);
		    }
		    if($PLabel)
		    {
			$CMD_Label .= ";ntfslabel -f /dev/$Dev$PNumber ".
			    substr($PLabel, 0, 8);
		    }
		    ++ $cnt;
		}
		close(DB);
		push(@fdisk, 'w');

		my $cmd = 'echo -e "';
		foreach(@fdisk)
		{
		    $cmd .= $_.'\n';
		}
		$cmd .= '" | fdisk /dev/'.$Dev.' 2>&1';
		LOG("    Cmd: [$cmd]\n");
		system($cmd);
		LOG("    Cmd: [$CMD_Label]\n");
		system($CMD_Label);

		last;
	    }
        }
        LOG("* Make C: a RAW unformated partition\n");
        system("dd if=/dev/zero of=/dev/$Dev"."1 count=1000 bs=1000");
        #
        # Better not! Decision is easier for windows setup if partition is seen as RAW.
        # print "* Format C: (NTFS)\n";
        # system("mkntfs -L SYSTEM /dev/$Dev"."1");
        #
        LOG("* Format D: (NTFS)\n");
        system("mkntfs -Q -L DATA /dev/$Dev"."2");
        {
            LOG("* Synchronize partition table again\n");
	    Synchronize_Device($Dev);
        }
        system("ntfsfix /dev/$Dev"."2");
        system("ntfslabel -f /dev/$Dev"."2 DATA");
        LOG("* You may safely download a RIS image (unattended setup)!\n");
    }

    elsif($Dev && $Entity =~/Create_New_Image/i)
    {
	my $New_Image = '';
	while(length($New_Image) < 1)
	{
	    my $cmd = 'dialog --inputbox "Enter the name of the '
		.'new image :" 8 51 2>/tmp/BLA';
	    system($cmd);
	    if(-e "/tmp/BLA")
	    {
		open(DB, "/tmp/BLA");
		while(<DB>)
		{
		    $New_Image .= $_;
		}
		close(DB);
		unlink("/tmp/BLA");
	    }
	    $New_Image =~s/^\s*//;
	    $New_Image =~s/\s*$//;
	    $New_Image =~s/\s/_/g;
	}
	LOG("* Name of future image: [$New_Image]\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 want gzip (faster),'
		.' bzip2 (less used space), or no compression to be used ?\n\n" 12 50 3 '
		.' "gzip" "" "bzip2" "" "no compression" "" 2>/tmp/checklist.tmp';
	    system($cmd);

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

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

	# Give the user the possibility to prefer zsplit to partimage
	#
	LOG("  Ask if zsplit must be preferred to partimage\n");

	if(defined($P{Zsplit_Preferred}))
	{
	    LOG("    There's a preconfig entry; worth [$P{Zsplit_Preferred}]\n");
	    if($P{Zsplit_Preferred} =~/^(y|1)$/i)
	    {
		$P{Zsplit_Preferred} = 1;
	    }
	    else
	    {
		$P{Zsplit_Preferred} = 0;
	    }
	}
	else
	{
	    LOG("    The user did not provide a Zsplit_Preferred entry in a"
		." ping.conf file => Ask.\n");

	    my $cmd = 'dialog --colors --menu "\Zb\Z7PING Partimage Is Not Ghost\n\n'
		.'\ZnDo you want zsplit to be used instead of partimage ? (Most users'
		.' should say NO.)\n\n" 13 50 2 '
		.' "No" "" "Yes" "" 2>/tmp/checklist.tmp';
	    system($cmd);

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

	    open(DB, "/tmp/checklist.tmp");
	    while(<DB>)
	    {
		if(m/y/i)
		{
		    $P{Zsplit_Preferred} = 1;
		    LOG("    Yes!\n");
		}
		else
		{
		    $P{Zsplit_Preferred} = 0;
		    LOG("    No!\n");
		}
	    }
	    close(DB);
	    `rm -f /tmp/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");
	    if($P{Minimize_Before_Storing} =~/^(y|1)$/i)
	    {
		$P{Minimize_Before_Storing} = 1;
	    }
	    else
	    {
		$P{Minimize_Before_Storing} = 0;
	    }
	}
	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;
	    }
	    else
	    {
		LOG("  AUTO param not set... let's ask the user\n");

		my $cmd = 'dialog --colors --menu "\Zb\ZnNTFS filesystems can be'
		    .' reduced before being stored. It permits restoring them to'
		    .' smaller partitions. Do you want us to minimize ? (Choose'
		    .' NO unless everything is backuped).\n\n" 13 50 2 '
		    .' "No" "" "Yes" "" 2>/tmp/checklist.tmp';
		system($cmd);

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

		open(DB, "/tmp/checklist.tmp");
		while(<DB>)
		{
		    if(m/Y/i)
		    {
			$P{Minimize_Before_Storing} = 1;
			last;
		    }
		}
		close(DB);
		unlink("/tmp/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 Captive NTFS/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 with $NTFS_MNT_TYPE.\n");
		system("umount /mnt/dos >/dev/null 2>&1;"
		       ." $NTFS_MNT /dev/$Part_For_Storage /mnt/dos >/dev/null 2>&1;"
		       ." umount /mnt/dos >/dev/null 2>&1;"
		       ." mount $NTFS_MNT_OPTIONS -t $NTFS_MNT_TYPE"
		       ." /dev/$Part_For_Storage /mnt/dos");

		LOG("  Checking the mounting...\n");
		my $tmp = `df |grep dos |wc -l`;
		$tmp =~s/\D//g;
		if($tmp)
		{
		    LOG("  Mounted !\n");
		    LOG("  *TIP* saving an image is faster on a FAT32 part.\n\n");
		    sleep($TIP_SLEEP);
		}
		else
		{
		    LOG("  ! Could not mount the device at all. Exit.\n");
		    sleep(5);
		    Quit();
		}
	    }
	}

	if(-d "$SRC/$New_Image")
	{
	    LOG("* Renaming old [$SRC/$New_Image] to [(...).OLD.$$]\n");
	    rename("$SRC/$New_Image", "$SRC/$New_Image.OLD.$$");
	}
	LOG("* Creating dir [$SRC/$New_Image]\n");
	mkdir("$SRC/$New_Image", 0755);

	# 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");
	my $cmd = "cmospwd -w \"$SRC/$New_Image/bios\"";
	LOG("  Cmd: [$cmd]\n");
	system($cmd);

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


	    # 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")
	    {
		my $cmd = "dd if=/dev/$HDD of=\"$SRC/$New_Image/$HDD\""
		    ." count=64 bs=512";
		LOG("    Cmd: [$cmd]\n");
		my $out = `$cmd`;
		LOG("    Out: [$out]\n");
	    }


	    # 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 and hiberfil.sys to remove\n");
	    {
		my $Type = Part_Type($P);
		LOG("      [/dev/$P]'s type: [$Type]\n");

		my $cmd = '';
		if(Is_NTFS($Type))
		{
		    $cmd = "$NTFS_MNT /dev/$P /mnt/win >/dev/null 2>&1;"
			." umount /mnt/win >/dev/null 2>&1;"
			." mount $NTFS_MNT_OPTIONS -t $NTFS_MNT_TYPE /dev/$P /mnt/win";
		}
		else
		{
		    $cmd = "mount /dev/$P /mnt/win >/dev/null 2>&1";
		}
		LOG("      Cmd: [$cmd]\n");
		system($cmd);

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

		$cmd = "umount /mnt/win >/dev/null 2>&1";
		LOG("      Cmd: [$cmd]\n");
		system($cmd);
	    }


	    # 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(Is_NTFS(Part_Type($P)))
	    {
		if($P{Minimize_Before_Storing})
		{
		    LOG("    Estimating [/dev/$P] future size\n");

		    my $New_Size = 0;
		    {
			system("umount /mnt/dos >/dev/null 2>&1;"
			       ."echo y|ntfsresize -i -f /dev/$P >/tmp/bla 2>&1");
			if(-e "/tmp/bla")
			{
			    open(DB, "/tmp/bla");
			    while(<DB>)
			    {
				if(m/^You might resize at/i)
				{
				    $New_Size = $_;
				    $New_Size =~s/^\D+([0-9]+)\sbytes.*$/$1/;
				    $New_Size =~s/\D//g;
				    LOG("    We can reduce to [$New_Size]\n");
				    last;
				}
			    }
			    close(DB);
			    unlink("/tmp/bla");
			}
		    }

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

			{
			    my $cmd = "echo y|ntfsresize -f -s $New_Size /dev/$P 2>&1";
			    LOG("    Cmd: [$cmd]\n");
			    my $out = `$cmd`;
			    $out =~s/^\s*//;
			    $out =~s/\s*$//;
			    LOG("    Output: [$out]\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.
			    #
			    my $tmp_End = '';
			    my $tmp_Blocks = '';
			    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 blocks for [$P]: [".$D->{Blocks}->[$i]."]\n");

				    $tmp_Blocks = $D->{Blocks}->[$i];
				    $tmp_End = $D->{End}->[$i];

				    $D->{End}->[$i] = $D->{Start}->[$i]
					+ int($New_Size / ($D->{Heads} * $D->{Sectors_Track} * 512));
				    $D->{Blocks}->[$i] =
					int(($D->{End}->[$i] - $D->{Start}->[$i] + 1)
					    * $D->{Heads} * $D->{Sectors_Track} * 512 / 1024);

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

			    Delete_All_Parts($HDD);
			    Recreate_All_Parts($HDD);

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

			    if($tmp_Blocks && $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 blocks for [$P]: [".$D->{Blocks}->[$i]."]\n");

					$D->{Blocks}->[$i] = $tmp_Blocks;
					$D->{End}->[$i] = $tmp_End;

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

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

			    ++ $Have_Minimized_Before_Storing;
			    push(@Minimized_Devices, $HDD);
			}
		    }
		    else
		    {
			LOG("    Won't resize to [$New_Size]... aborting this.\n");
		    }
		}
		else
		{
		    LOG("    Not wanted.\n");
		}
	    }
	    else
	    {
		LOG("    Not NTFS => no minimizing.\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($P{Zsplit_Preferred})
	    {
		LOG("    Zsplit is to be preferred to partimage. So, skip this step.\n");
	    }
	    else
	    {
		my $cmd = "dd if=/dev/$P of=\"$SRC/$New_Image/$P.first_sectors\""
		    ." count=20 bs=512";
		LOG("    Cmd: [$cmd]\n");
		my $out = `$cmd`;
		LOG("    Out: [$out]\n");

		# If dd didn't even record 20x512 bytes, no need to go on,
		# we took everything (probably a ext'd)
		#
		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");
		    next;
		}
	    }


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

	    if(Part_Type($P) eq "8e" || Part_Type($P) eq "82")
	    {
		LOG("    Well, no we won't (Part type: ["
		    .ID_To_Type(Part_Type($P))."])\n");
	    }
	    else
	    {
		# 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($P{Zsplit_Preferred})
		{
		    LOG("    The user wants zsplit to be preferred. Don't use partimage!\n");
		}
		else
		{
		    $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);

		    # Cleaning 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 partimage has 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")
		{
		    LOG("    ! Partimage has not written any partition.\n");
		    LOG("      We'll use zsplit.\n");
		    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");
		    }
		}
	    }
	}
    }

    elsif($Dev && $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");
		my $cmd = "umount /mnt/dos >/dev/null 2>&1";
		LOG("      Cmd: [$cmd]\n");
		system($cmd);
		if(Is_NTFS(Part_Type($P)))
		{
		    $cmd = "$NTFS_MNT /dev/$P /mnt/dos >/dev/null 2>&1;"
			." umount /mnt/dos >/dev/null 2>&1;"
			." mount $NTFS_MNT_OPTIONS -t $NTFS_MNT_TYPE /dev/$P /mnt/dos";
		}
		else
		{
		    $cmd = "mount /dev/$P /mnt/dos >/dev/null 2>&1";
		}
		LOG("      Cmd: [$cmd]\n");
		system($cmd);

		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");
		$cmd = "chntpw -l \"$SAM\" >/tmp/BLA";
		LOG("    Cmd: [$cmd]\n");
		system($cmd);

		my $Status = 0;
		if(-e "/tmp/BLA")
		{
		    open(DB, "/tmp/BLA");
		    while(<DB>)
		    {
			if(m/\<Administrator\>/i && m/locked/i)
			{
			    ++ $Status;
			    last;
			}
		    }
		    close(DB);
		    unlink("/tmp/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");
		system("umount /mnt/dos >/dev/null 2>&1");
	    }
	}
    }

    elsif($Dev && $Entity =~/Backup_Local_Hard_Disk/i)
    {
        my %SMB = ();
        my $Try_Again = 1;

        while($Try_Again)
	{
            foreach("Server", "Share", "User", "Passwd", "Directory")
	    {
                $SMB{$_} = "";
            }

            my $cmd = 'dialog --inputbox "Enter a valid SMB Server IP '
                .'(eg. 192.168.0.10)" 8 51 2>/tmp/BLA';
            system($cmd);
	    if(-e "/tmp/BLA")
	    {
		open(DB, "/tmp/BLA");
		while(<DB>)
		{
		    $SMB{Server} .= $_;
		}
		close(DB);
		unlink("/tmp/BLA");
	    }
            $SMB{Server} =~s/^\/*//;
            $SMB{Server} =~s/^\\*//;

            $cmd = 'dialog --inputbox "Enter a valid SMB Share Name '
                .'(eg. myshare)" 8 51 2>/tmp/BLA';
            system($cmd);
	    if(-e "/tmp/BLA")
	    {
		open(DB, "/tmp/BLA");
		while(<DB>)
		{
		    $SMB{Share} .= $_;
		}
		close(DB);
		unlink("/tmp/BLA");
	    }
            $SMB{Share} =~s/^\/*//;
            $SMB{Share} =~s/^\\*//;
            $SMB{Share} =~s/\$/\\\$/g;

            $cmd = 'dialog --inputbox "Enter a valid username '
                .'(eg. mydomain\runner)" 8 51 2>/tmp/BLA';
            system($cmd);
	    if(-e "/tmp/BLA")
	    {
		open(DB, "/tmp/BLA");
		while(<DB>)
		{
		    $SMB{User} .= $_;
		}
		close(DB);
		unlink("/tmp/BLA");
	    }
            $SMB{User} =~s/\//\\\\/g;
            $SMB{User} =~s/\\/\\\\/g;

            $cmd = 'dialog --inputbox "Enter a valid password '
                .'(eg. runner)" 8 51 2>/tmp/BLA';
            system($cmd);
	    if(-e "/tmp/BLA")
	    {
		open(DB, "/tmp/BLA");
		while(<DB>)
		{
		    $SMB{Passwd} .= $_;
		}
		close(DB);
		unlink("/tmp/BLA");
	    }
            $SMB{Passwd} =~s/\\/\//;

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

            LOG("* Unmounting [/mnt/smbfs]\n");
	    $cmd = "umount /mnt/smbfs >/dev/null 2>&1";
	    LOG("  Cmd: [$cmd]\n");
            system($cmd);
            LOG("* Trying to mount [//$SMB{Server}/$SMB{Share}] ("
		.($P{CIFS_Preferred} ? "cifs":"smbfs").")\n");
	    $cmd = "mount.".($P{CIFS_Preferred} ? "cifs":"smbfs")
		   ." //$SMB{Server}/$SMB{Share} /mnt/smbfs -o"
                   ." username=$SMB{User},password=\"$SMB{Passwd}\" >/tmp/out 2>&1";
	    {
		my $tmp = $cmd;
		$tmp =~s/password=\"$SMB{Passwd}\"/password=xxx/g;
		LOG("  Cmd: [$tmp]\n");
	    }
            system($cmd);

            $Try_Again = 0;
            if(-e "/tmp/out")
	    {
                open(DB, "/tmp/out");
                while(<DB>)
		{
		    if(m/failed/i || m/cannot/i || m/missing/i || m/error/i)
		    {
                        # 2nd chance (NAS sends false failures)
                        my $tmp = `df |grep smbfs |wc -l`;
                        $tmp =~s/\D//g;
                        unless($tmp)
			{
                            $Try_Again = 1;
                            LOG("\n* BAD Server, Share, User or Passwd."
				." Try CIFS, or all again.\n");
                            sleep(3);
                        }
                    }
                }
                close(DB);
                unlink("/tmp/out");
            }

	    if($Try_Again)
	    {
		LOG("* Unmounting [/mnt/smbfs]\n");
		my $cmd = "umount /mnt/smbfs >/dev/null 2>&1";
		LOG("  Cmd: [$cmd]\n");
		system($cmd);
		LOG("* Trying to mount [//$SMB{Server}/$SMB{Share}] ("
		    .($P{CIFS_Preferred} ? "smbfs":"cifs").")\n");
		$cmd = "mount.".($P{CIFS_Preferred} ? "smbfs":"cifs")
		       ." //$SMB{Server}/$SMB{Share} /mnt/smbfs -o"
		       ." username=$SMB{User},password=\"$SMB{Passwd}\""
		       ." >/tmp/out 2>&1";
		{
		    my $tmp = $cmd;
		    $tmp =~s/password=\"$SMB{Passwd}\"/password=xxx/g;
		    LOG("  Cmd: [$tmp]\n");
		}
		system($cmd);

		$Try_Again = 0;
		if(-e "/tmp/out")
		{
		    open(DB, "/tmp/out");
		    while(<DB>)
		    {
			if(m/failed/i || m/cannot/i || m/missing/i || m/error/i)
			{
			    # 2nd chance (NAS sends false failures)
			    my $tmp = `df |grep smbfs |wc -l`;
			    $tmp =~s/\D//g;
			    unless($tmp)
			    {
				$Try_Again = 1;
				LOG("\n* BAD Server, Share, User or Passwd."
				    ." TRY AGAIN.\n");
				sleep(3);
			    }
			}
		    }
		    close(DB);
		    unlink("/tmp/out");
		}
	    }

            if(! $Try_Again)
	    {
                my $cmd = 'dialog --inputbox "Enter a directory where to save data '
                    .'(eg. \MyBackup\MyPC-20060601)" 8 51 2>/tmp/BLA';
                system($cmd);
		$SMB{Directory} = '';
		if(-e "/tmp/BLA")
		{
		    open(DB, "/tmp/BLA");
		    while(<DB>)
		    {
			$SMB{Directory} .= $_;
		    }
		    close(DB);
		    unlink("/tmp/BLA");
		}
                $SMB{Directory} =~s/^\s*//;
                $SMB{Directory} =~s/\s*$//;
                $SMB{Directory} =~s/\\/\//g;
                $SMB{Directory} =~s/^\/*//;
            }
        }

        unless(-d "/mnt/smbfs/$SMB{Directory}")
	{
            LOG("* Making directory [//$SMB{Server}/$SMB{Share}/$SMB{Directory}]\n");
            system("mkdir -p \"/mnt/smbfs/$SMB{Directory}\"");
        }

        my(@Partitions) = ();
        {
            my @Do = ('p', 'q');
            my $cmd = 'echo -e "';
            foreach(@Do)
	    {
                $cmd .= $_.'\n';
            }
            $cmd .= '" | fdisk /dev/'.$Dev.' 2>&1';
            my $out = `$cmd`;

            my(@lines) = split(/\n/, $out);
            foreach my $L (@lines)
	    {
                $L =~s/^\s*//;
                $L =~s/\s*$//;
                next unless($L =~/^\/dev/i);
                $L =~s/  / /g;
                $L =~s/  / /g;
                $L =~s/  / /g;
                $L =~s/  / /g;
                $L =~s/  / /g;
                my(@fields) = split(/ /, $L);
                next if($fields[$#fields] =~/extended/i);
                push(@Partitions, $fields[0]);
            }
        }

        foreach my $P (@Partitions)
	{
            my $devname = (split(/\//, $P))[2];
            LOG("\n* Saving partition [$P] to"
                ." [//$SMB{Server}/$SMB{Share}/$SMB{Directory}/$devname]\n");

            LOG("  * Unmounting [/mnt/dos]\n");
            system("umount /mnt/dos >/dev/null 2>&1");

            LOG("  * Mounting [$P] on [/mnt/dos]\n");
            system("mount $P /mnt/dos");

            LOG("  * Tarball-making\n");
            my $cmd = "cd /mnt/dos; tar --exclude=pagefile.sys --exclude="
		."\"System Volume Information\" --exclude=hiberfile.sys"
		." -cvf - *|gzip -1 - |split -b 2000000000 -"
		." \"/mnt/smbfs/$SMB{Directory}/$devname.tar.gz.x\"";
            LOG("    [$cmd]\a\a\n");
            unless(-e "/mnt/smbfs/$SMB{Directory}/$devname.tar.gz.xab")
	    {
                rename("/mnt/smbfs/$SMB{Directory}/$devname.tar.gz.xaa",
                       "/mnt/smbfs/$SMB{Directory}/$devname.tar.gz");
            }
            sleep(3);
            system($cmd);

            LOG("  * Unmounting [/mnt/dos]\n");
            system("umount [/mnt/dos] >/dev/null 2>&1");
        }

        LOG("\n* BACKUP has been done.\n");
        LOG("* Unmounting [/mnt/smbfs]\n");
        system("umount /mnt/smbfs >/dev/null 2>&1");
    }
}
else
{
    my @Label_CMD = ();

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

    # 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");
		if($P{Replace_BIOS} =~/^(y|1)$/i)
		{
		    $P{Replace_BIOS} = 1;
		}
		else
		{
		    $P{Replace_BIOS} = 0;
		}
	    }
	    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 ?'
			.'\n\n" 12 50 2 '
			.' "Yes" "" "No" "" 2>/tmp/checklist.tmp';
		    system($cmd);

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

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

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

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

    # Several possible scenarii to tackle.
    #
    my $Action = "Ghost";
    foreach my $CurrFF (@FF)
    {
        my @fields = split(/\//, $CurrFF);
        my $F = $fields[-1];

	# Section added for cciss compatability (HP SmartArray). Same for ida and rd.
	#
	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[abcde]$/ || $F =~/(cciss|rd|ida|mapper)\/c\d{1}d\d{1,2}$/)
	{
            $Action = "Mixed";
            last;
        }
    }

    if($Action eq "Ghost")
    {
        LOG("* Classical Ghost-like image!\n");
    }
    elsif($Action eq "Mixed")
    {
        LOG("* Mixed image!\n");
    }

    if($Action eq "Ghost" || $Action eq "Mixed")
    {
        foreach my $FF (@FF)
	{
            my @fields = split(/\//, $FF);
            my $F = $fields[-1];
	    #
	    # Section added for cciss compatability (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 devices to restore
	    #
            if($F =~/[hs]d[abcde]$/ || $F =~/(cciss|ida|rd|mapper)\/c\d{1}d\d{1,2}$/)
	    {
                LOG("  * Restore [/dev/$F]\n");
                my $cmd = "dd if=$FF of=/dev/$F";
		LOG("    Cmd: [$cmd]\n");
                my $out = `$cmd`;
		LOG("    Out: [$out]\n");
		LOG("    Synchronizing [/dev/$F]\n");
		Synchronize_Device($F);
		++ $Have_Restored;
                last;
            }
            elsif($F =~/^bios$/i)
	    {
                LOG("  * Found [bios] file\n");
		if($P{Replace_BIOS})
		{
		    my $cmd = "echo 2|cmospwd -r \"$FF\"";
		    LOG("    Cmd: [$cmd]\n");
		    system($cmd);
		}
		else
		{
		    LOG("    BIOS settings must not be replaced. No action.\n");
		}
            }
        }
    }

    # The mixed case. Must:
    # - Partition according to instructions
    # - Apply either partimages, either untarrings (next scope)
    #
    if($Action eq "Mixed")
    {
        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[abcde]\.part$/i
	       || $F =~/(cciss|rd|ida|mapper)\/c\d{1}d\d{1,2}\.part$/)
            {
                my $Dev = $F;
                $Dev =~s/\.part$//i;

                LOG("  * Found [$F] => partitioning instructions.\n");
                my @fdisk = ('d', 1, 'd', 2, 'd', 3, 'd', 4, 'd', 5, 'd', 6);
                my $cnt = 0;
                open(DB, $FF);
                while(<DB>)
		{
                    s/^\s*//;
                    s/\s*$//;
                    s/\s/ /g;
                    while(m/  /)
		    {
                        s/  / /g;
                    }
                    next if(m/^\;/);
                    my @fields = split(/ /, $_);
                    next unless($#fields >= 2);
                    my($PNumber, $PSize, $PType, $PLabel, $PBoot) = @fields;

                    push(@fdisk, 'n', 'p', $PNumber, '');
                    if($PSize eq "+")
		    {
                        push(@fdisk, '');
                    }
		    else
		    {
                        push(@fdisk, "+$PSize");
                    }
                    push(@fdisk, 't');
                    if($cnt > 0)
		    {
                        push(@fdisk, $PNumber);
                    }
                    push(@fdisk, $PType);
                    if($PBoot eq "*")
		    {
                        push(@fdisk, 'a', $PNumber);
                    }

                    if($PLabel)
		    {
                        push(@Label_CMD, "ntfslabel -f /dev/$Dev$PNumber "
			     .substr($PLabel, 0, 8));
                    }

                    ++ $cnt;
                }
                close(DB);
                push(@fdisk, 'w');

                my $cmd = 'echo -e "';
                foreach(@fdisk)
		{
                    $cmd .= $_.'\n';
                }
                $cmd .= '" | fdisk /dev/'.$Dev.' 2>&1';
                LOG("    Cmd: [$cmd]\n");
                system($cmd);
            }
        }
    }

    if($Action eq "Ghost" || $Action eq "Mixed")
    {
	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)
	    {
		system("umount /dev/$CD_Dev >/dev/null 2>&1;"
		       ." mount /dev/$CD_Dev /mnt/cdrom >/dev/null 2>&1");
	    }
	    Read_Dir(\@F, \@FF, \$Multi);       # Will feed @F, @FF and $Multi

	    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$/)
		{
		    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$//;
		    my $cmd = "dd if=\"$FF\" of=/dev/$Dev";
		    LOG("    Cmd: [$cmd]\n");
		    my $out = `$cmd`;
		    LOG("    Out: [$out]\n");
		    LOG("    Synchronizing [/dev/$Dev]\n");
		    Synchronize_Device($Dev);

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

		    # 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.
		    #
		    $cmd = "vgchange -ay";
		    LOG("    Cmd: [$cmd]\n");
		    $out = `$cmd 2>&1`;
		    LOG("    Output: [$out]\n");
		}

		# 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 $cmd = "umount /dev/$Dev >/dev/null 2>&1";
		    LOG("    Cmd: [$cmd]\n");
		    system($cmd);
		    #
		    # 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 /tmp///toto.
		    #
		    # Now, unzsplit is happy again.
		    #
		    my $Base = $F;
		    $Base =~s/\_0.spl.zp$//;
		    $cmd = "rm -f /tmp/$Base.*.spl.zp >/dev/null 2>&1";
		    LOG("      Cmd: [$cmd]\n");
		    system($cmd);
		    my $A = "$SRC/$Entity/$Base"."_*.spl.zp";
		    $A =~s/\/+/\//g;
		    $cmd = "cd /tmp; ln -sf $A .";
		    LOG("      Cmd: [$cmd]\n");
		    system($cmd);

		    LOG("    Is [$F] concerned by the general MULTI flag ?\n");
		    my $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)
		    {
			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 /tmp; ln -sf $A .";
			$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.
		    #
		    $cmd = "cd /tmp; unzsplit ".($Multi && $Multi_Concerned ? "-m":"")
			." -d -D /dev/$Dev $Dev";
		    LOG("    Cmd: [$cmd]\n");
		    `$cmd`;
		    push(@Applied, $FF);
		    $Go_On = 1;
		    if(-e "/tmp/debug.log")
		    {
			my $out = "";
			open(DB, "/tmp/debug.log");
			while(<DB>)
			{
			    $out .= $_;
			}
			close(DB);
			unlink("/tmp/debug.log");
			LOG("      Output: [$out]\n");
		    }
		    system("rm -f /tmp/*.spl.zp >/dev/null 2>&1");

		    # Re-read the source directory (must have changed)
		    #
		    if($Multi && $Multi_Concerned)
		    {
			Read_Dir(\@F, \@FF, \$Multi);   # Will feed @F, @FF and $Multi
		    }
		}
		elsif($FF =~/\.000$/)
		{
		    my $Dev = $F;
		    $Dev =~s/\.\d{3}$//;
		    my $cmd = "umount /dev/$Dev >/dev/null 2>&1";
		    LOG("    Cmd: [$cmd]\n");
		    system($cmd);
		    if($Multi)
		    {
			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";
			$cmd = "/etc/rc.d/rc.multi partimage \"$Todo\" &";
			LOG("    * Multivol! Cmd: [$cmd]\n");
			system($cmd);
			$Go_On = 1;
		    }
		    $cmd = "sleep $PARTIMAGE_SLEEP; partimage ".($Multi ? "-w":"")
			." -f3 -b -c -d -o restore /dev/$Dev \"$FF\";"
			." sleep $PARTIMAGE_SLEEP; reset";
		    LOG("    Cmd: [$cmd]\n");
		    system($cmd);
		    push(@Applied, $FF);
		    $Go_On = 1;
		}
		elsif($FF =~/\.zip$/i)
		{
		    my $Dev = "";
		    {
			my @f1 = split(/\./, $F);
			$Dev = $f1[0];
		    }
		    my $TType = "";
		    {
			my $tmp = $Dev;
			$tmp =~s/\d+$//;
			my $out = `fdisk -l /dev/$tmp | grep \"^/dev/$F\"`;
			$out =~s/\+//g;
			$out =~s/\*//g;
			$out =~s/^\s*//;
			$out =~s/\s*$//;
			while($out =~/  /)
			{
			    $out =~s/  / /g;
			}
			my @fields = split(/ /, $out);
			if(Is_NTFS($fields[4]))
			{
			    $TType = "$NTFS_MNT_OPTIONS -t $NTFS_MNT_TYPE";
			}
		    }

		    foreach("umount /mnt/dos",
			    "mkntfs -Q -F /dev/$Dev",
			    "ntfsfix /dev/$Dev")
		    {
			LOG("    * [$_]\n");
			system($_);
		    }

		    # The tarball might be empty. Then, save time.
		    unless(-z $FF)
		    {
			foreach("$NTFS_CAP;"
				." mount $TType /dev/$Dev /mnt/dos >/dev/null 2>&1;"
				." umount /mnt/dos >/dev/null 2>&1;"
				." mount $TType /dev/$Dev /mnt/dos",
				"cd /mnt/dos; unzip $FF; sleep 2",
				"cd /; umount /mnt/dos; sleep 2")
			{
			    LOG("    * [$_]\n");
			    system($_);
			    push(@Applied, $FF);
			    $Go_On = 1;
			}
		    }
		}
	    }
	}
    }

    if($Action eq "Mixed")
    {
        foreach(@Label_CMD)
	{
            LOG("    * [$_]\n");
            system($_);
        }
    }
}


# Unmount the stuff.
#
LOG("* Unmounting [$SRC]\n");
system("umount $SRC >/dev/null 2>&1");


# 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($_);
	Recreate_All_Parts($_);
    }
}


# Sometimes, users might create images with a small hdd-equipped station,
# and restore it on stations with bigger hdds. They might use a hda.part
# 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 (NTFS only)\n");

    my(@NTFS_Devs_To_Check) = ();

    foreach my $D (@Dev)
    {
	my $out = `fdisk -l /dev/$D`;
	my(@L) = split(/\n/, $out);
	foreach my $Line (@L)
	{
	    next unless($Line =~/^\//);
	    $Line =~s/\*//g;
	    $Line =~s/\+//g;
	    $Line =~s/\s+/ /g;
	    my(@Fields) = split(/ /, $Line);
	    if($Fields[4] eq "7" || $Fields[4] eq "7")
	    {
		push(@NTFS_Devs_To_Check, $Fields[0]);
	    }
	}
    }

    foreach my $D (@NTFS_Devs_To_Check)
    {
	LOG("  - NTFS part to check: [$D]\n");
	my $out = `echo y|ntfsresize -i -f $D`;
	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("    Current volume size: [$CurVol]\n");
	LOG("    Current device size: [$CurDev]\n");

	if($CurVol < $CurDev)
	{
	    LOG("    We can augment the volume size!\n");
	    my $cmd = "echo y|ntfsresize -f -s $CurDev $D >>/tmp/x.log 2>&1";
	    LOG("    Cmd: [$cmd]\n");
	    system($cmd);
	}
    }
}



# The End
#
Quit();



sub LOG
{
    my $Say = shift;
    my $Now = Time();
    print "$$ $MYSELF $Now> $Say";
    open(LOG, ">>/tmp/x.log");
    print LOG "$$ $MYSELF $Now> $Say";
    close(LOG);
}



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 x.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 [/tmp/x.log]\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}]");
	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($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($P{No_Shell})
	{
	    sleep(60);
	    system("shutdown -h now");
	}
	else
	{
#	    Merge_Partimage_Log();

	    system("reset; clear");
	    print "\nYou are now given the possibility to login to the shell.\n";
	    print "Please, be aware that PING log is stored in /tmp/x.log.\n\n\a\a\a";
	    exit;
	}
    }
}



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

    my $out = `df`;
    my(@Lines) = split(/\n/, $out);
    foreach my $L (@Lines)
    {
	$L =~s/ +.*$//;
	return(1) if($L eq $Part);
    }
    return(0);
}



# Tells if a partition type is NTFS
#
sub Is_NTFS
{
    my($Type) = shift || '';
    return(($Type eq "7" || $Type eq "42") ? 1: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")
#
sub Is_Swap
{
    my($Part) = shift || '';
    return(0) unless($Part);

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

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

    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);

    # 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)
	    {
		return($D->{Types}->[$i]);
	    }
	}
    }

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

    my $HDD = HDD_Name($Part);

    system("fdisk -l /dev/$HDD | grep -i $Part >/tmp/bla 2>&1");
    if(-e "/tmp/bla")
    {
	open(DB, "/tmp/bla");
	while(<DB>)
	{
	    s/^\s*//;
	    s/\s*$//;
	    s/\*//g;    # Boot flag
	    s/\+//g;    # Blocks addon
	    while(m/\s\s/)
	    {
		s/\s\s/ /g;
	    }
	    $FS = (split(/ /, $_))[4];
	}
	close(DB);
	unlink("/tmp/bla");
    }
    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'
#
sub HDD_Name
{
    my $HDD = shift || '';
    $HDD =~s/^\/dev\///;
    if($HDD =~/^(cciss|rd|ida|mapper)/)
    {
	$HDD =~s/p\d+$//;
    }
    else
    {
	$HDD =~s/\d+$//;
    }
    return($HDD);
}



# Ex.: Part_Number('/dev/hda1');    # returns 1
#      Part_Number('cciss/c0d0p2'); # returns 2
#
sub Part_Number
{
    my($pnum) = shift || '';
    $pnum =~s/^.*\D(\d+)$/$1/;
    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:
#   "f" => "W95 Ext'd (LBA)",
#   "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);
    }
}



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



# Display the results of the HDD discovery.
#
sub HDD_Describe
{
    foreach my $D (@Dev_Rich)
    {
	LOG("HDD_Describe> Device: [".$D->{Dev}."]\n");
	LOG("HDD_Describe>   P.Table-read Heads: [".$D->{Heads}."]\n");
	LOG("HDD_Describe>   P.Table-read Sectors/track: [".$D->{Sectors_Track}."]\n");
	LOG("HDD_Describe>   P.Table-read Cylinders: [".$D->{Cylinders}."]\n");
	LOG("HDD_Describe>   BIOS-read Heads: [".$D->{BIOS_Heads}."]\n");
	LOG("HDD_Describe>   BIOS-read Sectors/track: [".$D->{BIOS_Sectors_Track}."]\n");
	LOG("HDD_Describe>   BIOS-read Cylinders: [".$D->{BIOS_Cylinders}."]\n");

	for(my $i = 0; $i <= $#{ $D->{Parts} }; $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>     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>     Blocks: [".$D->{Blocks}->[$i]."]\n");
	}
    }
}



# Delete all partitions of a device.
# Ex.: Delete_All_Parts("hda");
#
sub Delete_All_Parts
{
    my $DEVICE = shift || '';

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

    LOG("Delete_All_Parts> * Suppressing all parts from device [$DEVICE]\n");

    # 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 (@Dev_Rich)
    {
	LOG("Delete_All_Parts>   Device [".$D->{Dev}."]\n");

	if($D->{Dev} eq $DEVICE)
	{
	    my $Last_Type = '';
	    my(@tmp) = ();
	    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++)
		{
		    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, '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");
	}
    }
}



# Re-create all partitions of a device.
# Ex.: Recreate_All_Parts("hda");
#
sub Recreate_All_Parts
{
    my $DEVICE = shift || '';

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

    LOG("Recreate_All_Parts> * Re-creating all parts of device [$DEVICE]\n");

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

	if($D->{Dev} eq $DEVICE)
	{
	    my(@tmp) = ();
	    my $cnt = 0;

	    for(my $i = 0; $i <= $#{ $D->{Parts} }; $i++)
	    {	
		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($i > 0)
		{
		    push(@tmp, Part_Number($D->{Parts}->[$i]));
		}
		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, '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");
	}
    }
}



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\n");

    opendir(DIR, "$SRC/$Entity");
    @{ $pF } = readdir(DIR);
    closedir(DIR);

    # See if multivol asked...
    #
    ${ $pMulti } = (-e "$SRC/$Entity/MULTI") ? 1:0;

    # Resolving symlinks
    #
    LOG("  * Resolving possible symlinks\n");
    LOG("    * Before:\n");
    foreach(@{ $pF })
    {
        LOG("    * [$_]\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("    * Symlink. Points to [$Link]\n");
            if(-e "$SRC/$Entity/$Link")
            {
                push(@{ $pFF }, "$SRC/$Entity/$Link");
            }
            else
            {
                LOG("      * [$SRC/$Entity/$Link] can't be found!!!\n");
                sleep(5);
                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("    * After:\n");
    foreach(@{ $pFF })
    {
        LOG("      * [$_]\n");
    }

    # Sorting data. .first_sectors/.fir files first.
    #
    LOG("  * Re-ordering\n");
    my @files = @{ $pFF };
    @{ $pFF } = ();
    foreach(@files)
    {
	if(m/\/bios$/)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/\/[hs]d[abcde]$/)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(m/\.first_sectors$/ || m/\.fir$/)
	{
	    push(@{ $pFF }, $_);
	}
    }
    foreach(@files)
    {
	if(! m/\/bios$/ && ! m/\/[hs]d[abcde]$/ && ! m/\.first_sectors$/
	   && ! m/\.fir$/)
	{
	    push(@{ $pFF }, $_);
	}
    }
    LOG("    * Re-ordered:\n");
    foreach(@{ $pFF })
    {
        LOG("      * [$_]\n");
    }
}



__END__

=== Todos ===

  - Partition resizings should use parted when NTFS is not concerned.
    Add subs to handle this easier.
  - Handle ext parts with (h|s)da.part. Example:
    1   20M    83   boot      *
    2   250M   83   logging   /
    3   128M   82   swap      /
    4   +      5    ext       /
    5   1000M  83   root      /
    6   +      83   vms       /
    Line 4 => should n + e
    Line 5 => should n + l + 1000M
  - Means using new discovery-related subs so to recreate all parts.
  - Would be nice if a boot sector could be written... instead of
    dd-ing 20 first sectors of /dev/(h|s)da.
  - When the source is hda* and there's no hda where to restore to
    but a sda, we might propose it.
  - Bugs with multi. When there's on a CD hda1.000, up to 00x, and
    hda2.000, there's no need to call rc.multi for hda1.*. No csq.
    Real bug, when hda3.000 is on a 2nd CD, there's no eject, nor
    call to the restoration process.
  - Create_New_Image should be a possible Image_To_Restore choice.
  - Add a param to choose the compression method (for automatic image
    creation).
  - Add a $DATE param to be replaced by current day's date.
  - Add a param to add a customized name and version for welcome screen.
  - Add params to auto-restore from a local HDD.
  - Possibility to write 'skip' on the welcome screen to
    avoid ping.conf/kernel-passed params to be taken into
    account. We don't advertise it on the welcome screen.
  - Add a facultative instruction text file to the image directory
    to say: this image must be applied to this device, or to hda then
    sda if hda unavailable, then cciss/c0d0 for ex.

=== Hypothetical todos ===

  - 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)

  - We could stop using  partimage, and make use of tar+gz, then
    many  things  would  be  possible,  like  exploring  the  backups,
    etc. BUT, and this is a big but, ACLs and file attributes would be
    lost, unless a windows tool  like icacls.exe being used before and
    after the linux  step. Maybe an idea for later,  but I dislike the
    idea of having  things done under Windows. (Note  that there would
    be no  such problem when  backing up and restoring  linux systems,
    for example;  so, the  choice could be  proposed to the  user when
    Creating a new image, someday.)

  - 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

=== Remember... ===

* Creating LVM:

fdisk ... 8e
pvcreate /dev/hda2
vgcreate VolGroup00 /dev/hda2
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.