--- a/kvmtool Wed Aug 26 16:04:24 2009 +0200
+++ b/kvmtool Wed Aug 26 17:48:45 2009 +0200
@@ -6,16 +6,16 @@
use strict;
use warnings;
-use Getopt::Long;
+use Getopt::Long qw(:config require_order);
use Pod::Usage;
use File::Basename;
use Perl6::Slurp;
use File::Path;
use IO::File;
use IO::Select;
-use if $ENV{DEBUG} => qw(Smart::Comments);
+use POSIX qw(setsid);
use feature qw(:5.10);
-use if $ENV{DEBUG} => "Smart::Comments";
+use if $ENV{DEBUG} => qw(Smart::Comments);
my $ME = basename $0;
my $opt_dev = "/dev/kvm";
@@ -33,8 +33,8 @@
sub _import(@);
sub _base_dir($) { "$opt_base/vm/$_[0]" }
-sub _running_config_file($) { "$opt_base/vm/$_[0]/running_config" }
-sub _user_config_file($) { "$opt_base/vm/$_[0]/config" }
+sub _config_running_file($) { "$opt_base/vm/$_[0]/running_config" }
+sub _config_user_file($) { "$opt_base/vm/$_[0]/config" }
sub _monitor_link($) { "$opt_base/vm/$_[0]/monitor" }
MAIN: {
@@ -64,27 +64,29 @@
}
sub cmd_start(@) {
- my ($kvm) = @_;
+ my ($kvm, @kvm_opts) = @_;
pod2usage() if not defined $kvm;
-d _base_dir $kvm or mkpath _base_dir $kvm;
- my $config = config->load_user_config(
- $kvm => defined $opt_config ? $opt_config : _user_config_file $kvm);
+ my $config = config->load_config_user($kvm,
+ defined $opt_config ? $opt_config : _config_user_file $kvm, @kvm_opts);
- -d dirname $config->get("-pidfile")
- or die "$ME: directory for pidfile ("
- . $config->get("-pidfile")
- . "): $!\n";
+ if (defined(my $pidfile = $config->get("-pidfile"))) {
+ -d dirname $pidfile
+ or die "$ME: directory for pidfile ($pidfile): $!\n";
+ }
- $config->save_user_config(_user_config_file $kvm)
+ $config->save_config_user(_config_user_file $kvm)
if defined $opt_config and defined $opt_import;
- $config->save_running_config(_running_config_file $kvm);
+ $config->save_config_running(_config_running_file $kvm, @kvm_opts);
defined(my $pid = open(VM, "-|")) or die "Can't fork: $!\n";
if ($pid == 0) {
+ setsid();
+ open(STDIN, "</dev/null");
open(STDERR, ">&STDOUT")
or die "Can't redirect STDERR to STDOUT: $!\n";
exec $KVM "kvm-$kvm" => $config->get_all();
@@ -172,13 +174,13 @@
sub cmd_kill(@) {
my ($kvm) = @_;
pod2usage() if not defined $kvm;
- my $config = config->load_running_config(_running_config_file $kvm);
+ my $config = config->load_config_running(_config_running_file $kvm);
my $pidfile = $config->get("-pidfile");
my $pid = slurp $pidfile, { chomp => 1 };
kill $KILL => $pid;
waitpid($pid, 0);
- unlink $pidfile, _monitor_link $kvm, _running_config_file $kvm;
+ unlink $pidfile, _monitor_link $kvm, _config_running_file $kvm;
}
@@ -195,8 +197,8 @@
my %data;
- sub load_user_config {
- my ($class, $kvm, $file) = @_;
+ sub load_config_user {
+ my ($class, $kvm, $file, @extra_opts) = @_;
my $self = bless do { \my $x }
=> $class;
@@ -208,27 +210,28 @@
push @config, "-pidfile $opt_base/vm/$kvm/pid"
unless /^-pidfile\b/ ~~ @config;
$data{$self}{config} = \@config;
+ $data{$self}{extra} = \@extra_opts;
return $self;
}
- sub save_running_config {
+ sub save_config_running {
my ($self, $file) = @_;
DumpFile($file, $data{$self});
}
- sub save_user_config {
+ sub save_config_user {
my ($self, $file) = @_;
my $fh = new IO::File ">$file" or die "$file: $!\n";
$fh->print(
join "\n",
"# kvm configuration file",
"# imported kvm config, you *may* edit this file",
- @{ $data{$self}{config} }
+ @{ $data{$self}{config} }, undef
);
}
- sub load_running_config {
+ sub load_config_running {
my ($class, $file) = @_;
my $self = bless do { \my $x }
=> $class;
@@ -244,8 +247,8 @@
sub get_all {
my ($self) = @_;
- return map { split " ", $_, 2 } grep !/^\s*#/,
- @{ $data{$self}{config} };
+ return +(map { split " ", $_, 2 } grep !/^\s*#/,
+ @{ $data{$self}{config} }), @{ $data{$self}{extra} };
}
sub DESTROY {
@@ -263,7 +266,7 @@
=head1 SYNOPSIS
- kvmtool [options] start [--config <config> [--import]] [--monitor] <name>
+ kvmtool [options] start <name> [kvm-options]
kvmtool [options] monitor <name>
kvmtool [options] kill <name>
@@ -273,8 +276,22 @@
=head2 start
+The B<start> command starts the virtual machine. It looks for the
+startup config in the vm config space. For a new machine you may want to
+use the B<--config> option to specify (and optionally import) the
+new configuration.
+
+Options just used once (e.g. boot off a CDROM) may be passed too.
+
=head2 monitor
+This opens a connection to the monitor of the specified VM.
+
+=head2 kill
+
+The B<kill> command kills the machine, using normal UNIX process
+manipulation tools.
+
=head1 OPTIONS
Some of the following options are of general nature (as B<--base-dir>), some