#!/usr/bin/perl -w

# This is a perl script for cloning/backing-up/restoring disk/image to another,
# This can run on SystemRescue (tested Ver11.00/12.00).

use Data::Dumper;
use Getopt::Long;
use JSON::PP;
use Clone qw(clone);
use Fcntl;
use File::Temp qw(tempfile);
use IO::File;
use IO::Compress::Zip qw(zip $ZipError); # SystemRescue don't have Archive::Zip
use IO::Uncompress::Unzip qw(unzip $UnzipError);
use strict;
use warnings;

# set $ENV{'PATH'} for security
$ENV{'PATH'} = "/usr/bin:/bin";

# Global Values
our %opts;
our $srci;
our $dsti;

# program version
our $VERSION = "2025-05-09-0";

# align sector into 1MB
our $ALIGNSIZE = 1024*1024; 
# first partition start from 1MB
our $FIRSTPARTSTART = 1024*1024;
# reserved size(2MB) of the last of the disk, as Windows
our $LASTRESERVE = 2*1024*1024;
# copy buffer size(100MB)
our $COPYBUFSIZE = 1024*1024*100; #100MB
# backup file version, which is in "DiskClone" file in backup file(zip)
our $BACKUP_FILE_VERSION = "1.0";
# MBR size ... is a top of the physical disk.
our $MBRSIZE = 1024*1024; # 1MB

# print usage
sub print_usage {
	print "clone disk from src_device to dst_device\n";
	print "usage: $0 [options] <src_device> <dst_device>\n";
	print "   ex. $0 /dev/sda /dev/sdb\n";
	print "options:\n";
	print "--help     : show this message\n";
	print "--test     : test only, nothing changed\n";
	print "--compact  : shrink partitions to the top of the dst disk\n";
	print "--winlocate: relocate partitions as of Windows default\n";
	print "--reorder  : reorder the partitions from the top of the disk\n";
	print "--winonly  : clone Windows partitions only\n";
	print "--verbose  : display further information\n";
	print "--partonly : partitioning only, not clone filesystems\n";
	print "--forcedd  : not use partclone but use dd for all partitions\n";
	print "--only=<part>    : clone only specified partitions on <src_device>, delimited by ','\n";
	print "--except=<part>  : clone except specified partitions on <src_device>, delimited by ','\n";
	print "--partdata=<file>: read partition data from file insted of <src_device>\n";
	print "--info=<dev>     : list partitions in <src_device>\n";
	print "--check=<bkup>   : check the backup file consistency\n";
	exit 1;
}


# if got SIGPIPE, die immediately.
$SIG{PIPE} = sub {
	my $signame = shift;
	die "Got SIG$signame, try --verbose\n";
};


# run command and return the output as array
# Argument: command string, error message
# Note: $? can be checked after this function
# when error($? != 0):
#   if $errmes is undefined, return all output
#   if $errmes is defined, print command and its output then die
sub cmd {
	my ($cmdline, $errmes) = @_;
	if ($cmdline =~ /[;\n|]/) {
		print "# $cmdline\n";
		die "command includes invalid charactors";
	}
	my @ret = `$cmdline 2>&1`;
	my $output = "# $cmdline\n".join('', @ret);
	print $output if ($opts{verbose});
	return @ret if ($? == 0 || !defined($errmes));

	print $output if (!$opts{verbose});
	die $errmes;
}
# run command and return the output as string
# Argument: command string, error message
sub cmd1 {
	my ($cmdline, $errmes) = @_;
	my $ret = join('', cmd($cmdline, $errmes));
	chomp $ret;
	return $ret;
}


# get partition device(ex. /dev/nvme0n1p1, /dev/sda1)
# Argument: whole of device(ex. /dev/sda), partition(ex./dev/sda1, or 1)
sub get_partdev {
	my ($dev, $part) = @_;
	$part =~ s/.*?(\d+)$/$1/;
	return ($dev =~ /\d$/) ? "${dev}p$part" : "$dev$part";
}


# align partition sector *after* the argument
# Argument: sector
# Return  : aligned start sector
sub align_sector {
	my ($sect, $sectsiz) = @_;
	my $elm = int($ALIGNSIZE/$sectsiz);
	return int(($sect+$elm-1)/$elm)*$elm;
}
# align partition sector *before* the argument
sub align_sector_before {
	my ($sect, $sectsiz) = @_;
	my $elm = int($ALIGNSIZE/$sectsiz);
	return int($sect/$elm)*$elm;
}
# convert sector number for the disk($from_sectsize) to one($to_sectsize)
sub convert_sector {
	my ($sect, $from_sectsiz, $to_sectsiz) = @_;
	return int((($sect*$from_sectsiz)+$to_sectsiz-1)/$to_sectsiz);
	# do not align, for DOS pt clone.
}
# size to sector/sector
sub size_to_sector {
	my ($siz, $sectsiz) = @_;
	return int(($siz+$sectsiz-1)/$sectsiz);
}
# get whole disk size(in byte)
sub get_disk_size {
	# --getsz shows "size in 512byte/sector", how about 4096byte/sector?
	return cmd1("blockdev --getsize64 $_[0]", "Fail to get size");
}
# get logical sector size(in byte, ex. 512, 4096)
sub get_sector_size {
	return cmd1("blockdev --getss $_[0]", "Fail to get size");
}


# check if it is windows partition on gpt
sub is_windows_partition {
	my $t = $_[0];
	return
		$t eq "C12A7328-F81F-11D2-BA4B-00A0C93EC93B" || # EFI system partition
		$t eq "E3C9E316-0B5C-4DB8-817D-F92DF00215AE" || # MS reserved part
		$t eq "EBD0A0A2-B9E5-4433-87C0-68B6B72699C7" || # Data partition
		$t eq "5808C8AA-7E8F-42E0-85D2-E1E90434CFB3" || # LDM metadata partition
		$t eq "AF9B60A0-1431-4F62-BC68-3311714A69AD" || # LDM data partition
		$t eq "DE94BBA4-06D1-4D40-A16A-BFD50179D6AC";  # Recovery partition
}


# check if the partition table is gpt/dos.
sub is_gpt { return $_[0]->{label} eq "gpt"; }
sub is_dos { return $_[0]->{label} eq "dos"; }


# check if it is a backup file
sub is_backup_file_exist { return (-f $_[0]); }
sub is_backup_file       { return (is_backup_file_exist($_[0]) || !-e $_[0]); }
sub is_blkdev { return (-b $_[0]); }


# get disk information by "sfdisk -J $dev" and return reference of data
# Argument: whole device(ex. /dev/sda)
# Return  : hash reference of the disk information
sub get_disk_info {
	my $dev = $_[0];
	my $ret;
	if (is_backup_file($dev))  {
		# This is a backup archive file 
		print "Getting source backup-archive-file information...\n";
		my $zip = open_file_in_zip_r($dev, "parttbl.json");
		$ret = decode_json(join('', <$zip>));
		close $zip;
		# $ret->{disksize} has been defined in backup archive file
		# $ret->{partitions}[#]->{fs} has also been defined
	} else { # if is_blkdev($dev) {
		# This is a block device
		print "Getting source device information...\n";
		my @lines = cmd("sfdisk -J $dev", "Cannot get device info");
		$ret = (decode_json(join('', @lines)))->{partitiontable};
		# get disksize(internal data, sector number of the disk)
		$ret->{disksize} = get_disk_size($dev)/$ret->{sectorsize};
		# must be integer

		# store each fs
		foreach my $p (@{$ret->{partitions}}) {
			$p->{fs} = get_filesystem_name($p->{node});
			$p->{fs} = "dd" if ($opts{forcedd} || $p->{fs} eq "");
		}
	}
	return $ret;
}


# Get sfdisk string of the disk
# Argument: reference of the disk information
# Return  : string used for sfdisk
sub get_sfdisk_string {
	my $pt = $_[0];
	my $ret = "";

	$ret .= "label: $pt->{label}\n";
	$ret .= "label-id: $pt->{id}\n";
	$ret .= "device: $pt->{device}\n";
	$ret .= "unit: $pt->{unit}\n";
	# "if (...)" is necessary to apply both gpt/dos partition table.
	$ret .= "first-lba: $pt->{firstlba}\n" if ($pt->{firstlba});
	$ret .= "last-lba: $pt->{lastlba}\n"   if ($pt->{lastlba});
	$ret .= "sector-size: $pt->{sectorsize}\n\n";
	foreach (@{$pt->{partitions}}) {
		$ret .= "$_->{node} : start=$_->{start}, size=$_->{size}, type=$_->{type}";
		$ret .= ", uuid=$_->{uuid}"       if ($_->{uuid});
		$ret .= ", name=\"$_->{name}\""   if ($_->{name});
		$ret .= ", attrs=\"$_->{attrs}\"" if ($_->{attrs});
		$ret .= ", bootable"              if ($_->{bootable});
		$ret .= "\n"
	}
	return $ret;
}


# open file with io-op('|', '<', '>')
# Argument: strings of op and command
# return  : file handler
sub io_open {
	my ($op, $cmd) = @_;
	my $fh;
	$cmd .= " 2>/dev/null"          if (!$opts{verbose});
	print "io_open('op', '$cmd')\n" if  ($opts{verbose});
	open($fh, $op, $cmd) || die "Fail to open('$cmd'), try --verbose";
	binmode $fh;
	return $fh;
}


# Clone MBR from src to dst device(only 1MB... good enough for most cases)
# Argument: src_device, dst_device
# Return  : nothing
sub clone_mbr {
	my ($src, $dst, $zip) = @_;
	print "Cloning MBR...\n";
	if (is_blkdev($src) && is_blkdev($dst)) {
		cmd("dd if=$src of=$dst bs=$MBRSIZE count=1 2>/dev/null", "Fail to clone MBR");
		return;
	}
	my $data;
	if (is_backup_file($src) && is_blkdev($dst)) {
		# when restoring
		my $fh = open_file_in_zip_r($src, "mbr.dat");
		$fh->read($data, $MBRSIZE) || die "Fail clone_mbr($src)";
		$fh->close();
		$fh = io_open("|-", "dd of=$dst bs=$MBRSIZE");
		# "count=1" should not be added, as pipe is sometimes iterated
		print $fh $data || die "Fail clone_mbr($dst)";
		close($fh);
	} elsif (is_blkdev($src) && is_backup_file($dst)) {
		# when backing-up
		my $fh = io_open("-|", "dd if=$src bs=$MBRSIZE count=1");
		read($fh, $data, $MBRSIZE) || die "Fail clone_mbr($src)";
		close($fh);
		add_newfile_into_zip($zip, "mbr.dat");
		write_to_zip($zip, $data);
	}
}


# Apply disk information by running "sfdisk $dev < tmpfile"
# Argument: reference of the disk information
sub apply_disk_info {
	print "Applying destination device information...\n";
	my $pt = $_[0];
	my ($fh, $fnam) = tempfile();
	print $fh get_sfdisk_string($pt);
	close($fh);
	# it is important to make tempfile to check it after any errors.
	cmd("sfdisk $pt->{device} < $fnam", "Fail to apply partdata");
	unlink $fnam;
	cmd("blockdev --rereadpt $pt->{device}", "Fail to re-read partition table");

	# "blockdev --rereadpt" could refresh /dev/*, so wait for the device files
	foreach (@{$pt->{partitions}}) {
		for (my $i= 0; $i < 3 && !is_blkdev($_->{node}); $i++) {
			sleep(1);
		}
		is_blkdev($_->{node}) || die "$_->{node} is not block dev";
	}
}


# Write partition table(json) into zip as "parttbl.json"
# Argument: destination device(=file) information
# Return  : N/A
sub write_parttbl_into_zip {
	my $dsti = $_[0];
	add_newfile_into_zip($dsti->{zipfh}, "parttbl.json");

	# $dsti->{zipfh} should not be saved into parttbl.json
	my $hash = clone($dsti);
	delete $hash->{zipfh};
	write_to_zip($dsti->{zipfh}, encode_json($hash));
}


# change the device name in the disk information
# Argument: reference of the disk information, device
sub change_device_name {
	print "Configuring destination device...\n";
	my ($pt, $dev) = @_;
	$pt->{device} = $dev;

	my $fromsiz = $pt->{sectorsize};
	my $tosiz = is_blkdev($dev) ? get_sector_size($dev) : $fromsiz;
	# if blkdev, disk size need to be changed suitably
	# if backup file, keep disk size as it is cloned from source
	if (is_blkdev($dev)) {
		$pt->{sectorsize} = $tosiz;
		$pt->{disksize} = get_disk_size($dev)/$tosiz; # must be integer
		# This is gpt only, "dos" does not have {lastlba};
		$pt->{lastlba} = $pt->{disksize}-34 if (is_gpt($pt));
	}

	# change partition name appropriately as its device name
	my $devnam = is_blkdev($dev) ? $dev : "part";
	foreach (@{$pt->{partitions}}) {
		$_->{node}  = get_partdev($devnam, $_->{node});
		$_->{start} = convert_sector($_->{start}, $fromsiz, $tosiz);
		$_->{size}  = convert_sector($_->{size},  $fromsiz, $tosiz);
	}
}


# process "--only" and "--except" options
# Argument: reference of the disk information
sub process_only_except_option {
	my @pts = @{$_[0]->{partitions}};
	if (defined($opts{only})) {
		my @devs = split(/,/, $opts{only});
		@pts = grep { my $d = $_->{node};  print "d: $d\n"; grep(/^$d$/, @devs) } @pts;
	}
	if (defined($opts{except})) {
		my @devs = split(/,/, $opts{except});
		@pts = grep { my $d = $_->{node}; !grep(/^$d$/, @devs) } @pts;
	}
	$_[0]->{partitions} = \@pts;
}


# Comact/shrink partitions, means place all partitions without unused space
# Argument: reference of the disk information
sub compact_partitions {
	print "Compacting partitions...\n";
	my @pts = @{$_[0]->{partitions}};
	my $sectsiz = $_[0]->{sectorsize};

	# 1st partition should be after 1MB(2048s on 512b/sector)
	my $start = size_to_sector($FIRSTPARTSTART, $sectsiz);
	# place all partitions without gap
	foreach my $t (@pts) {
		$t->{start} = align_sector($start, $sectsiz);
		$start = $t->{start} + $t->{size};
	}
}


# locate partitions as Windows:
#     try to locate EFI first, reserved next, then C and Recovery last
# Argument: reference of the disk information
sub winlocate_partitions {
	print "Relocating partitions for Windows...\n";
	my $pt = $_[0];
	my @pts = @{$pt->{partitions}};
	my $sectsiz = $pt->{sectorsize};

	# search Recovery partition and place it on the last of the disk
	my @recov = grep { $_->{type} eq "DE94BBA4-06D1-4D40-A16A-BFD50179D6AC"} @pts;
	my $end = $pt->{disksize}-1-size_to_sector($LASTRESERVE, $sectsiz);
	# as Windows GTP, last 2MB(4096 with 512b/sect) is reserved.
	foreach my $t (@recov) {
		$t->{start} = align_sector_before($end-$t->{size}+1, $sectsiz);
		$end = $t->{start}-1;
		@pts = grep($_ ne $t, @pts); # remove the partition from @pts
		# though I don't know there are two or more recover partitions
	}

	my $start = size_to_sector($FIRSTPARTSTART, $sectsiz);
	# search "EFI system partition" and place it on the top of the disk
	my @efis = grep {$_->{type} eq "C12A7328-F81F-11D2-BA4B-00A0C93EC93B" } @pts;
	foreach my $t (@efis) {
		$t->{start} = align_sector($start, $sectsiz);
		$start = $t->{start} + $t->{size};
		@pts = grep($_ ne $t, @pts); # remove the partition from @pts
		# though I don't know there are not two or more efi partitions
	}

	# search "Microsoft reserved partition" and place it next to EFI
	my @reserv = grep {$_->{type} eq "E3C9E316-0B5C-4DB8-817D-F92DF00215AE"} @pts;
	foreach my $t (@reserv) {
		$t->{start} = align_sector($start, $sectsiz);
		$start = $t->{start} + $t->{size};
		@pts = grep($_ ne $t, @pts); # remove the partition from @pts
		# though I don't know there are two or more reserved partitions
	}

	# place all other partitions to the next
	foreach my $t (@pts) {
		$t->{start} = align_sector($start, $sectsiz);
		$start = $t->{start} + $t->{size};
	}
}


# modify partition order as "starting earlier is first"
# Argument: reference of the disk information
sub reorder_partitions {
	print "Reordering partitions...\n";
	my $pt = $_[0];
	my $ptsp = $pt->{partitions};

	@$ptsp = sort { $a->{start} <=> $b->{start} } @$ptsp;
	for(my $i = 0; $i <= $#$ptsp; $i++) {
		$ptsp->[$i]{node} = get_partdev($pt->{device}, $i+1);
	}
}


# get filesystem name by fsstat or trying mount 
# Argument: partition(ex. /dev/sda1, /dev/sdb1)
# return  : filesystem name or "" if nothing found
sub get_filesystem_name {
	my ($part) = @_;
	my $ret = cmd1("fsstat -t $part");
	return $ret if ($? == 0 && $ret ne "");
	# Note: parted is not suitable, as it refreshs /dev/*, often lose the devfile
	# So trying mouinting it and check the filesystem here
	cmd("mount -r $part /mnt");
	return "" if ($? != 0);
	my @partdat = cmd("mount");
	cmd("umount $part", "Fail to umount");
	@partdat = grep(/^$part on /, @partdat);
	return ($#partdat != 0) ? "" : (split(/\s+/, $partdat[0]))[4];
}


# Add new file into zip file 
# Argument: zip_file_handler(writable), new_file_name
# return  : N/A
sub add_newfile_into_zip {
	my ($zip, $name) = @_;
	print "add_newfile_into_zip('$name')\n" if ($opts{verbose});
	unless ($zip->newStream(Name=>"$name")) {
		die "Fail add_newfile_into_zip($zip, $name), $ZipError";
	}
}
# write data into zip
# Argument: zip_file_handler, data
# Return  : N/A
sub write_to_zip {
	my ($zip, $data) = @_;
	print "write_to_zip()\n" if ($opts{verbose});
	unless ($zip->write($data)) {
		die "Fail write_to_zip(), $ZipError";
	}
}
# open internal file in zip file for read
# Argument: "zip_file_name", "internal_file_name"
# Return  : file handler(readable only) of the internal file 
sub open_file_in_zip_r {
	my ($zipname, $name) =@_;
	my $ret;
	print "open_file_in_zip_r('$zipname', '$name')\n" if ($opts{verbose});
	unless ($ret = IO::Uncompress::Unzip->new($zipname, Name=>$name)) {
		die "Fail open_file_in_zip_r($zipname, $name), $ZipError";
	}
	return $ret;
}
# open internal file in zip file for write(zip file is newly opened)
# Argument: "zip_file_name", "internal_file_name"
# Return  : file handler(writable) of the internal file 
sub open_file_in_zip_w {
	my ($zipname, $name) =@_;
	my $ret;
	print "open_file_in_zip_w('$zipname', '$name')\n" if ($opts{verbose});
	unless ($ret = IO::Compress::Zip->new($zipname, Name=>$name, Zip64=>1)) {
		die "Fail open_file_in_zip_w($zipname, $name), $ZipError";
	}
	return $ret;
}


# backup a partition from device to onto zip file 
# Argument: src_partition, dst(="part#"), filesystem, zip_filehandler
# Return  : N/A
sub backup_partition {
	my ($src, $dst, $fs, $zip) = @_;

	is_blkdev($src) || die "backup_partition: $src must be block dev";
	is_blkdev($dst) && die "backup_partition: $dst must be a file in zip";
	add_newfile_into_zip($zip, $dst);  # $dst must be "part#"
	my $cmd = "partclone.$fs -z $COPYBUFSIZE -s $src";
	$cmd .= " -c" if ($fs ne "dd");
	my $fh = io_open("-|", $cmd);
	while (read($fh, my $buf, $COPYBUFSIZE)) {
		write_to_zip($zip, $buf);
	}
	close($fh);
}


# restore a partion from zip file to device
# Argument: src(="part#"), dst_partition, filesystem, zip_filename
# Return  : N/A
sub restore_partition {
	my ($src, $dst, $fs, $zip) = @_;

	is_backup_file($zip) || die "restore_partition $zip must be a file";
	is_blkdev($dst) || die "restore_partition: $dst must be block dev";
	my $z = open_file_in_zip_r($zip, $src); # $src must be "part#"
	my $cmd = "partclone.$fs -z $COPYBUFSIZE -o $dst";
	$cmd .= " -r" if ($fs ne "dd");
	$cmd .= " 2>/dev/null" if (!$opts{verbose});
	my $fh = io_open("|-", $cmd);
	while ($z->read(my $buf, $COPYBUFSIZE)) {
		unless (print $fh $buf) {
			die "Fail to restore($dst)";
		}
	}
}


# Clone partition
# Argument: src_info, src_partition, dst_info, dst_partition, filesystem
sub clone_partition {
	my($srci, $src, $dsti, $dst, $fs) = @_;

	if (is_backup_file($src)) {
		print "Restoring from $srci->{device}:$src to $dst, fs=$fs ...\n";
		restore_partition($src, $dst, $fs, $srci->{device});
		return;
	}
	if (is_backup_file($dst)) {
		print "Backing-up from $src to $dsti->{device}:$dst, fs=$fs ...\n";
		backup_partition($src, $dst, $fs, $dsti->{zipfh});
		return;
	}
	print "Cloning from $src to $dst, fs=$fs ...\n";
	# partclone buffer size(-z) is 100MB
	my $cmdline = "partclone.$fs -z 104857600 -s $src -o $dst";
	$cmdline .= " -b" if ($fs ne "dd"); # partclone.fs does not have -b option
	cmd($cmdline);
	return if ($? == 0);
	die   "  Fail to run partclone.$fs\n";
# for compatibility for backup_partition()/restore_partition(), omit this... 
#	print "  Fail to run partclone.$fs, try dd...\n";
#	print "Cloning partition from $src to $dst...\n";
#	cmd("dd if=$src of=$dst bs=100M 2>/dev/null", "Fail to clone partition");
}


# clone all partitions in the dst device from src to dst for gpt
# Argument: src_device_information, dst_device_information
sub clone_all_partitions_gpt {
	print "Cloning partitions on gpt...\n";
	my ($srci, $dsti) = @_;
	my $srcpt = $srci->{partitions};
	my $dstpt = $dsti->{partitions};

	# sort by partition size, not to spend time to wait errors occur
	my @dstpary = sort { $a->{size} <=> $b->{size} } @$dstpt;

	foreach my $dstp (@dstpary) {
		my @parts = grep {$dstp->{uuid} eq $_->{uuid}} @$srcpt;
		($#parts == 0) || die "Wrong src corresponding to $dstp->{node}";
		my $srcnode = $parts[0]->{node};
		my $fs = $dstp->{fs};
		clone_partition($srci, $srcnode, $dsti, $dstp->{node}, $fs);
	}
}


# clone all partitions from src to dst for dos pt
# Argument: src_device_information, dst_device_information
sub clone_all_partitions_dos {
	print "Cloning partitions on dos...\n";
	my ($srci, $dsti) = @_;
	my $srcpt = $srci->{partitions};
	my $dstpt = $dsti->{partitions};

	# dos has many restrictions...
	($#$srcpt == $#$dstpt) || die "src/dst partition number is different";

	for(my $i=0; $i <= $#$srcpt; $i++) {
		my ($srcp, $dstp) = ($srcpt->[$i], $dstpt->[$i]);
		next if ($srcp->{type} eq "f"); # skip extend partition
		my $fs = $srcp->{fs};
		clone_partition($srci,$srcp->{node}, $dsti,$dstp->{node}, $fs);
		print "\n";
	}
}


# read sfdisk data which is generated by "sfdisk -d <dev>"
# Argument: filename of the data(which is genereted by "sfdisk -d <dev>"
# Return  : reference of the hash of the sfdisk data
sub read_sfdisk_data {
	my $file = $_[0];
	my $ret = {};

	my $fh = io_open("<", $file);
	while (<$fh>) {
		chomp;
		last if (/^\s*$/);
		my ($key, $val) = split(/\s*:\s+/, $_);
		$key =~ s/label-id/id/;
		$key =~ s/-//g; # remove '-' like "first-lba" to "firstlba"
		$key =~ s/^\s*(.*?)\s*$/$1/;
		$val =~ s/^\s*(.*?)\s*$/$1/;
		$ret->{$key} = $val;
	}
	$ret->{partitions} = [];
	for (my $i = 0; <$fh>; $i++) {
		chomp;
		my ($key, $val) = split(/\s*:\s+/, $_);
		$key =~ s/^\s*(.*?)\s*$/$1/;
		$val =~ s/^\s*(.*?)\s*$/$1/;
		$ret->{partitions}[$i]->{node} = $key;
		foreach (split(/\s*,\s*/, $val)) {
			# FIXME: split() can't work if there's ',' in string
			# ex: 'a=b, c="d,e,f", f=g'
			if (/^bootable$/) {
				$ret->{partitions}[$i]->{bootable} = 1;
			} else {
				my ($key, $val) = split(/\s*=\s*/);
				$val =~ s/^"(.*)"$/$1/;
				$ret->{partitions}[$i]->{$key} = $val;
			}
		}
	}
	close($fh);
	return $ret;
}


# Ask Yes or No and return true or false
# Argument: message
sub ask_yn {
	my $msg = $_[0];
	while(1) {
		print "$msg [y/n] ";
		my $line = <STDIN>;
		chomp($line);
		($line eq 'y') && return 1;
		($line eq 'n') && return 0;
		print "Please input \"y\" or \"n\"\n";
	}
}


# remove non-windows partitions
# Argument: reference of the disk information, device
sub remove_nonwin_partitions {
	my $pt = $_[0];
	my @ptary = @{$pt->{partitions}};
	@ptary = grep { is_windows_partition($_->{type}) } @ptary;
	$pt->{partitions} = \@ptary;
}


# check backup file version
# Argument: backup_file(zip)
# Return  : bool(but it exit if this is not a backup file)
sub check_backup_file_version {
	my $f = $_[0];
	is_backup_file_exist($f) || die "$f must be a backup file";

	# check if version is valid
	print "Checking version in $f:DiskClone... ";
	STDOUT->flush();
	my $zip = open_file_in_zip_r($f, "DiskClone");
	my $buf = join('', <$zip>);
	$zip->close();
	print "$buf\n";

	chomp $buf;
	# check the version
	if ($buf == "1.0") {
		return 1; # can be handled
	}
	return 0; # This tool can not handle the backup file
}


# check backup file(zip)
# Argument: backup_file(zip)
# Return  : N/A.
sub check_backup_file {
	my $f = $_[0];
	is_backup_file_exist($f) || die "$f must be a backup file";

	# check if version is valid
	check_backup_file_version($f) || die "$f has invalid version";
	# check if parttbl.json is readable
	print "Checking $f:parttble.json...\n";
	my $zip = open_file_in_zip_r($f, "parttbl.json");
	my $buf = join('', <$zip>);
	$zip->close();

	# check if mbr.dat is readable and its size is $MBRSIZE
	print "Checking $f:mbr.dat...\n";
	$zip = open_file_in_zip_r($f, "mbr.dat");
	$zip->read($buf, $MBRSIZE) || die "Error, failed to read";
	close $zip;

	# check all partitions by partclone.chkimg(except fs=dd)
	my $dinfo = get_disk_info($f);
	foreach my $p (@{$dinfo->{partitions}}) {
		print "Checking $p->{node}(fs=$p->{fs})... "; #'\n' is unneeded
		STDOUT->flush();
		if ($p->{fs} eq "dd") {
			print "Skip as 'dd'\n";
			# do nothing currently...
			next;
		}
		$zip = open_file_in_zip_r($f, $p->{node});
		my $fh = io_open("|-", "partclone.chkimg -s -");
		while ($zip->read($buf)) {
			print $fh $buf || die "Fail to run partclone.chkimg";
		}
		$zip->close();
		close($fh);
	}
}


# main function
{ 
	print "DiskClone ver $VERSION\n";

	my $oret = GetOptions(\%opts, "help", "test", "compact", "winlocate", 
				"reorder", "winonly", "verbose", "partdata=s",
				"forcedd", "partonly", "only=s", "except=s",
				"info=s", "check=s");
	if (!$oret || $opts{help} ||
	   (!$opts{info} && !$opts{check} && $#ARGV != 2-1)) {
		print_usage();
	}

	if ($opts{info}) {
		# show backup file informatin
		if (is_backup_file($opts{info})) {
			check_backup_file_version($opts{info});
			# no error handling, just print backup file version
		}
		my $data = get_disk_info($opts{info});
		my $json = JSON::PP->new->ascii->pretty->allow_nonref;
		print "\nDevice/Backupfile '$opts{info}' contains:\n";
		print $json->utf8->canonical->encode($data);
		exit 0;	
	}

	if ($opts{check}) {
		# check backup file(zip) whether it is broken
		check_backup_file($opts{check});
		exit 0;
	}

	my ($srcdev, $dstdev) = @ARGV;
	$srci = get_disk_info($srcdev);

	# label should be "gpt" or "dos"
	if (!is_gpt($srci) && !is_dos($srci)) {
		die "disk($srci->{device}) label($srci->{label}) must be gpt/dos";
	}
	if (is_dos($srci) &&
		($opts{compact} || $opts{winlocate} || $opts{reorder} || 
		 $opts{winonly} || $opts{except} || $opts{only})) {
		die "compact/winlocate/reorder/winonly/except/only can not be used for dos";
	}

	if (is_backup_file($srcdev)) {
		if (!check_backup_file_version($srcdev)) {
			die "Backup file($srcdev) has invalid version";
		}
	}
	if (is_backup_file_exist($dstdev)) {
		die "Backup file($dstdev) exists, should be new file";
	}

	if ($opts{partdata}) {
		$dsti = read_sfdisk_data($opts{partdata});
		change_device_name($dsti, $dstdev);
	} else {
		$dsti = clone($srci);
		process_only_except_option($dsti);
		change_device_name($dsti, $dstdev);
		($opts{winonly})   && remove_nonwin_partitions($dsti);
		($opts{compact})   && compact_partitions($dsti);
		($opts{winlocate}) && winlocate_partitions($dsti);
		($opts{reorder})   && reorder_partitions($dsti);
	}

	if (!is_blkdev($srci->{device}) && !is_blkdev($dsti->{device})) {
		die "one of src($srci->{device})/dst($dsti->{device}) must be block device";
	}

	if (is_backup_file($dsti->{device})) {
		print "\nBackup file($dsti->{device}) will be archived as:\n";
	} else  {
		print "\nDestination disk($dsti->{device}) will be changed to:\n";
	}
	print get_sfdisk_string($dsti)."\n";
	if ($opts{test}) {
		print "Do nothing, due to test\n";
		exit 0;
	}

	if (is_backup_file($dsti->{device})) {
		if (!ask_yn("Progress creating backup file?")) {
			die "aborted";
		}
		$dsti->{zipfh} = open_file_in_zip_w($dsti->{device}, "DiskClone");
		write_to_zip($dsti->{zipfh}, $BACKUP_FILE_VERSION);
		# do not close the filehander, will be used later
	} else {
		if (!ask_yn("ALL PARTITIONS on $dsti->{device} will be REMOVEd. OK?")) {
			die "aborted";
		}
	}

	# clone mbr for any OS(I know GPT does not need this, however...)
	clone_mbr($srci->{device}, $dsti->{device}, $dsti->{zipfh});

	# partitioning
	if (is_blkdev($dsti->{device})) {
		apply_disk_info($dsti);
	} else {
		write_parttbl_into_zip($dsti);
	}
	if ($opts{partonly}) {
		print "no partition clone, due to --partonly\n";
		print "Succeeded.\n";
		exit 0;
	}

	clone_all_partitions_gpt($srci, $dsti) if (is_gpt($srci));
	clone_all_partitions_dos($srci, $dsti) if (is_dos($srci));

	if (is_backup_file($dsti->{device})) {
		$dsti->{zipfh}->close();
	}

	print "Succeeded.\n";
	exit 0
}