76 lines
1.4 KiB
Perl
76 lines
1.4 KiB
Perl
|
#!/usr/bin/env perl
|
||
|
|
|
||
|
|
use v5.36.0;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use utf8;
|
||
|
|
|
||
|
|
use Path::Tiny;
|
||
|
|
use lib path(__FILE__)->parent->child('lib') . '';
|
||
|
|
|
||
|
|
use BaseUtils;
|
||
|
|
|
||
|
|
my $utils = BaseUtils->new;
|
||
|
|
|
||
|
|
main();
|
||
|
|
|
||
|
|
sub main() {
|
||
|
|
die 'Must be superuser.' if $< != 0;
|
||
|
|
my $source_dir = shift @ARGV or die 'No source dir passed.';
|
||
|
|
$source_dir = path $source_dir;
|
||
|
|
my $dest_img = shift @ARGV // 'gentoo.qcow2';
|
||
|
|
if (-e $dest_img) {
|
||
|
|
die "Image $dest_img already exists.";
|
||
|
|
}
|
||
|
|
$dest_img = path $dest_img;
|
||
|
|
my $size_img = shift @ARGV // 1000;
|
||
|
|
umountQemuNbd();
|
||
|
|
modprobeNbd();
|
||
|
|
createQemuImage($dest_img, $size_img);
|
||
|
|
mountQemuNbd($dest_img);
|
||
|
|
createPartitionTable();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub createPartitionTable {
|
||
|
|
open my $fh, "|-", 'fdisk', '/dev/nbd1';
|
||
|
|
print $fh <<'EOF';
|
||
|
|
g
|
||
|
|
n
|
||
|
|
|
||
|
|
|
||
|
|
+20M
|
||
|
|
t
|
||
|
|
1
|
||
|
|
n
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
w
|
||
|
|
EOF
|
||
|
|
close $fh;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub createQemuImage($dest_img, $size_img) {
|
||
|
|
my $return_code = system 'qemu-img', 'create', '-f', 'qcow2', $dest_img, $size_img.'M';
|
||
|
|
if ($return_code != 0) {
|
||
|
|
die 'Unable to create qemu-img.';
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub modprobeNbd {
|
||
|
|
system 'rmmod', '-f', 'nbd';
|
||
|
|
system 'modprobe', 'nbd';
|
||
|
|
}
|
||
|
|
|
||
|
|
sub mountQemuNbd($dest_img) {
|
||
|
|
my $return_code = system 'qemu-nbd', '--connect=/dev/nbd1', $dest_img;
|
||
|
|
if ($return_code != 0) {
|
||
|
|
die 'Unable to mount qemu-nbd.';
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub umountQemuNbd {
|
||
|
|
system 'qemu-nbd', '--disconnect', '/dev/nbd1';
|
||
|
|
}
|