--- a/kvmtool Sun Aug 16 23:08:03 2009 +0200
+++ b/kvmtool Tue Aug 25 23:28:40 2009 +0200
@@ -1,6 +1,9 @@
#! /usr/bin/perl
# © 2009 Heiko Schlittermann
+# $opt_base/vm/{name}/
+#
+
use strict;
use warnings;
use Getopt::Long;
@@ -10,106 +13,151 @@
use File::Path;
use IO::File;
use IO::Select;
+use if $ENV{DEBUG} => qw(Smart::Comments);
use feature qw(:5.10);
use if $ENV{DEBUG} => "Smart::Comments";
-my $ME = basename $0;
-my $opt_dev = "/dev/kvm";
-my $opt_monitor = 0;
+my $ME = basename $0;
+my $opt_dev = "/dev/kvm";
+my $opt_base = "$ENV{HOME}/.$ME";
+my $opt_cmd_monitor = undef;
+my $opt_config = undef;
+my $opt_import = undef;
+
+my $KVM = "kvm";
+my $KILL = 15;
-my $KVM = "kvm";
-my $BASE = "$ENV{HOME}/.$ME";
-my $CONFIG = "%s.kvm.conf";
-my $KILL = 15;
+sub cmd_start(@);
+sub cmd_kill(@);
+sub cmd_monitor(@);
+sub _import(@);
-sub _start(@);
-sub _kill(@);
-sub _monitor(@);
+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 _monitor_link($) { "$opt_base/vm/$_[0]/monitor" }
MAIN: {
GetOptions(
- "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
- "man" => sub { pod2usage(-verbose => 2, -exit => 0) },
- "m|monitor" => \$opt_monitor,
- "dev=s" => \$opt_dev,
+ "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
+ "man" => sub { pod2usage(-verbose => 2, -exit => 0) },
+ "m|monitor" => \$opt_cmd_monitor,
+ "c|config=s" => \$opt_config,
+ "d|base-dir=s" => \$opt_base,
+ "i|import" => \$opt_import,
+ "dev=s" => \$opt_dev,
) or pod2usage(-exit => 1);
- my $cmd = shift;
-
-w $opt_dev or die "$ME: write access to $opt_dev: $!\n";
- given ($cmd) {
+ given (shift) {
when ("start") {
- _start(@ARGV);
- _monitor(@ARGV) if $opt_monitor;
+ cmd_start(@ARGV);
+ cmd_monitor(@ARGV) if $opt_cmd_monitor;
}
- when ("monitor") { _monitor(@ARGV) }
- when ("kill") { _kill(@ARGV) }
+ when ("monitor") { cmd_monitor(@ARGV) }
+ when ("kill") { cmd_kill(@ARGV) }
default { pod2usage() };
}
}
-sub read_config($) {
- defined(my $kvm = shift) or pod2usage;
- my @config = slurp sprintf($CONFIG, $kvm), { chomp => 1 };
- (shift @config) =~ /^#\s+kvm/
- or die "wrong file format (\"# kvm\" expected)\n";
-
- push @config, "-name $kvm" unless /^-name\b/ ~~ @config;
- push @config, "-monitor pty" unless /^-monitor\b/ ~~ @config;
- push @config, "-pidfile $BASE/run/$kvm/pid" unless /^-pidfile\b/ ~~ @config;
-
- return @config;
-}
-
-sub _kill(@) {
- my $kvm = shift;
- my @config = read_config($kvm);
-
- (/^-pidfile\s+(?<pidfile>.*)/ ~~ @config);
- my $pid = slurp $+{pidfile}, { chomp => 1 };
+sub cmd_kill(@) {
+ my ($kvm) = @_;
+ pod2usage() if not defined $kvm;
+ my $config = config->load_running_config(_running_config_file $kvm);
+ my $pidfile = $config->get("-pidfile");
+ my $pid = slurp $pidfile, { chomp => 1 };
kill $KILL => $pid;
waitpid($pid, 0);
- unlink $+{pidfile};
+ unlink $pidfile, _monitor_link $kvm, _running_config_file $kvm;
+
}
-sub _start(@) {
- my $kvm = shift;
- my @config = read_config($kvm);
+sub cmd_start(@) {
+ my ($kvm) = @_;
+ 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);
- mkpath("$BASE/run/$kvm");
+ -d dirname $config->get("-pidfile")
+ or die "$ME: directory for pidfile ("
+ . $config->get("-pidfile")
+ . "): $!\n";
+
+ $config->save_user_config(_user_config_file $kvm)
+ if defined $opt_config and defined $opt_import;
+
+ $config->save_running_config(_running_config_file $kvm);
defined(my $pid = open(VM, "-|")) or die "Can't fork: $!\n";
if ($pid == 0) {
open(STDERR, ">&STDOUT")
or die "Can't redirect STDERR to STDOUT: $!\n";
- exec $KVM "kvm-$kvm" => map { split " ", $_, 2 } @config;
+ exec $KVM "kvm-$kvm" => $config->get_all();
die "Can't exec: $!";
}
- <VM> ~~ /\s(\S+)$/;
- symlink($1, "$BASE/run/$kvm/monitor");
+ if (defined($_ = <VM>)) {
+ print $_;
+ if (/char device redirected to (\S+)$/) {
+ unlink(_monitor_link $kvm);
+ symlink($1, _monitor_link $kvm);
+ exit;
+ }
+
+ wait;
+ die "$ME: didn't start: (exit ", $? >> 8, ")\n";
+
+ }
+
}
-sub _monitor(@) {
- my $kvm = shift;
- my @config = read_config($kvm);
- my $i = new IO::File("<$BASE/run/$kvm/monitor");
- my $o = new IO::File(">$BASE/run/$kvm/monitor");
+sub cmd_monitor(@) {
+ my ($kvm, $cmd) = (shift, "@_");
+ pod2usage() if not defined $kvm;
+
+
+ my $monitor = _monitor_link $kvm;
+ my $pts = readlink $monitor
+ or die "$ME: $monitor: $!\n";
+
+ my $i = new IO::File("<$pts") or die "$pts: $!\n";
+ my $o = new IO::File(">$pts") or die "$pts: $!\n";
$o->autoflush(1);
+ if (length $cmd) {
+ die "passing a command to monitor is not yet implemented\n";
+ $_ = "";
+ while (not /^\(qemu\) /) {
+ sysread($i, $_, 1, length);
+ $_ = "" if /\n$/;
+ }
+ syswrite($o, "$cmd\n");
+ $_ = "";
+ while (not /^\(qemu\) /m) {
+ sysread($i, $_, 1, length);
+ }
+ s/^.*?\r?\n//;
+ s/(\r?\n).*?$/$1/;
+ die "<$_>";
+ exit;
+ }
+
say("** to leave the monitor, just use the <ESC> key!");
my $termio = `stty -g`;
my $rows = (split " ", `stty size`)[0];
system("stty raw -echo");
eval {
- my $row = 0;
+ my $row = 1;
INPUT:
while (my @ready = IO::Select->new($i, \*STDIN)->can_read(undef)) {
foreach my $fh (@ready) {
@@ -120,14 +168,14 @@
if (/\n/ and $row++ >= $rows) {
syswrite(STDOUT, "more...");
sysread(STDIN, $_, 1);
- $row = 0;
+ $row = 1;
}
}
elsif ($fh == \*STDIN) {
(sysread(STDIN, $_, 1) == 0 or /\e/)
and print("\r\n"), last INPUT;
syswrite($o, $_);
- $row = 0;
+ $row = 1;
}
}
}
@@ -135,6 +183,77 @@
system("stty $termio");
}
+{
+
+ package config;
+ use strict;
+ use warnings;
+ use YAML::Syck;
+ use Perl6::Slurp;
+ use feature qw(:5.10);
+
+ use Data::Dumper;
+
+ my %data;
+
+ sub load_user_config {
+ my ($class, $kvm, $file) = @_;
+ my $self = bless do { \my $x }
+ => $class;
+
+ my @config = slurp $file, { chomp => 1 };
+
+ $data{$self}{kvm} = $kvm;
+ push @config, "-name $kvm" unless /^-name\b/ ~~ @config;
+ push @config, "-monitor pty" unless /^-monitor\b/ ~~ @config;
+ push @config, "-pidfile $opt_base/vm/$kvm/pid"
+ unless /^-pidfile\b/ ~~ @config;
+ $data{$self}{config} = \@config;
+
+ return $self;
+ }
+
+ sub save_running_config {
+ my ($self, $file) = @_;
+ DumpFile($file, $data{$self});
+ }
+
+ sub save_user_config {
+ 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} });
+ }
+
+ sub load_running_config {
+ my ($class, $file) = @_;
+ my $self = bless do { \my $x }
+ => $class;
+ $data{$self} = LoadFile($file);
+ return $self;
+ }
+
+ sub get {
+ my ($self, $key) = @_;
+ my @a = map { /^$key\s+(.*)/ ? $1 : () } @{ $data{$self}{config} };
+ return wantarray ? @a : $a[0];
+ }
+
+ sub get_all {
+ my ($self) = @_;
+ return map { split " ", $_, 2 } grep !/^\s*#/,
+ @{ $data{$self}{config} };
+ }
+
+ sub DESTROY {
+ my $self = shift;
+ delete $data{$self};
+ }
+
+}
+
__END__
=head1 NAME
@@ -143,22 +262,39 @@
=head1 SYNOPSIS
- kvmtool <start|kill|monitor> <name>
+ kvmtool [options] start [--config <config> [--import]] [--monitor] <name>
+ kvmtool [options] monitor <name>
+ kvmtool [options] kill <name>
=head1 DESCRITPTION
+=head1 COMMANDS
+
+=head2 start
+
+=head2 monitor
+
=head1 OPTIONS
+Some of the following options are of general nature (as B<--base-dir>), some
+other options are only useful in combination with some specific action
+(as B<--monitor>). You may pass as many useless options as you want ;-)
+
=over
+=item B<-c>|B<--config> I<config>
+
+Use the specified configuration instead of the one once imported.
+(default: I<undef>)
+
+=item B<-i>|B<--import>
+
+Import the specified configuration. (default: I<undef>)
+
=item B<--dev>=I<device>
Pathname of the KVM device. (default: /dev/kvm)
-=item B<--dir>=I<dir>
-
-Directory for meta share information about KVMs.
-
=item B<-h>|B<--help>
Show a short help page.