code: extra options are possible now
authorHeiko Schlittermann <hs@schlittermann.de>
Wed, 26 Aug 2009 17:48:45 +0200
changeset 13 20a7c2277b67
parent 12 c372a47ee501
child 14 94dcabb84ca8
code: extra options are possible now
kvmtool
--- 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