source: trunk/vmctl/vmctl @ 567

#!/usr/bin/env perl
# NOTICE
# Unlike everything else in this repository, this file does not come with
# any particular license, as the author (zev) stopped being involved before we
# got down to putting a license on the project.
use warnings;
use strict;

my $subcmd = shift;

my %cmds = ("install" => \&install);


if (exists $cmds{$subcmd}) {
  $cmds{$subcmd}->();
} else {
  print "No such subcommand: '$subcmd'\n";
}

sub install {
  my ($installer, $host_device) = @ARGV;
  $host_device =~ s#^/dev/##;
  my $installer_hostname = "magic";
  my $guest_dev = $host_device;
  $guest_dev =~ tr#/#_#;

  run("xm", "block-attach", $installer, "phys:$host_device", "$guest_dev", "rw");
  run("remctl", $installer_hostname, "installer", "install", $guest_dev);
  run("xm", "block-detach", $installer, $guest_dev, "rw");
}

sub run {
  system("echo", @_);
}