# HG changeset patch # User Heiko Schlittermann # Date 1251235720 -7200 # Node ID f48202d2c4a0900cf846bb009f26f3d3abf71f4f # Parent e1956a6cd9283ed512931f73cdbfcadcc34e736b code: start/kill/config handling diff -r e1956a6cd928 -r f48202d2c4a0 kvmtool --- 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+(?.*)/ ~~ @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: $!"; } - ~~ /\s(\S+)$/; - symlink($1, "$BASE/run/$kvm/monitor"); + if (defined($_ = )) { + 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 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 + kvmtool [options] start [--config [--import]] [--monitor] + kvmtool [options] monitor + kvmtool [options] kill =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 + +Use the specified configuration instead of the one once imported. +(default: I) + +=item B<-i>|B<--import> + +Import the specified configuration. (default: I) + =item B<--dev>=I Pathname of the KVM device. (default: /dev/kvm) -=item B<--dir>=I - -Directory for meta share information about KVMs. - =item B<-h>|B<--help> Show a short help page.