--- a/kvmtool Mon Aug 10 22:50:28 2009 +0200
+++ b/kvmtool Sun Aug 16 23:08:03 2009 +0200
@@ -7,61 +7,66 @@
use Pod::Usage;
use File::Basename;
use Perl6::Slurp;
+use File::Path;
+use IO::File;
+use IO::Select;
use feature qw(:5.10);
use if $ENV{DEBUG} => "Smart::Comments";
-my $ME = basename $0;
-my $opt_dev = "/dev/kvm";
-my $opt_dir = "/var/lib/kvm";
+my $ME = basename $0;
+my $opt_dev = "/dev/kvm";
+my $opt_monitor = 0;
-my $KVM = "kvm";
-my $CONFIG = "%s.kvm.conf";
-my $PIDFILE = "$ENV{HOME}/.kvm-%s.pid";
-my $KILL = 15;
+my $KVM = "kvm";
+my $BASE = "$ENV{HOME}/.$ME";
+my $CONFIG = "%s.kvm.conf";
+my $KILL = 15;
sub _start(@);
sub _kill(@);
+sub _monitor(@);
MAIN: {
GetOptions(
- "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
- "m|man" => sub { pod2usage(-verbose => 2, -exit => 0) },
- "dev=s" => \$opt_dev,
- "dir=s" => \$opt_dir,
+ "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
+ "man" => sub { pod2usage(-verbose => 2, -exit => 0) },
+ "m|monitor" => \$opt_monitor,
+ "dev=s" => \$opt_dev,
) or pod2usage(-exit => 1);
my $cmd = shift;
-w $opt_dev or die "$ME: write access to $opt_dev: $!\n";
- -w $opt_dir or die "$ME: write access to $opt_dir: $!\n";
- _start(@ARGV) if $cmd eq "start";
- _kill(@ARGV) if $cmd eq "kill";
- die "internal error\n";
+ given ($cmd) {
+ when ("start") {
+ _start(@ARGV);
+ _monitor(@ARGV) if $opt_monitor;
+ }
+ when ("monitor") { _monitor(@ARGV) }
+ when ("kill") { _kill(@ARGV) }
+ default { pod2usage() };
+ }
}
-sub get_config($) {
+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";
+ or die "wrong file format (\"# kvm\" expected)\n";
- if (not /^-pidfile/ ~~ @config) {
- push @config, sprintf "-pidfile $PIDFILE", $kvm;
- }
-
- if (not /^-name/ ~~ @config) {
- push @config, "-name $kvm";
- }
+ 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 = get_config($kvm);
+ my @config = read_config($kvm);
(/^-pidfile\s+(?<pidfile>.*)/ ~~ @config);
my $pid = slurp $+{pidfile}, { chomp => 1 };
@@ -69,22 +74,65 @@
kill $KILL => $pid;
waitpid($pid, 0);
unlink $+{pidfile};
-
- exit;
}
sub _start(@) {
my $kvm = shift;
- my @config = get_config($kvm);
+ my @config = read_config($kvm);
- defined(my $pid = fork) or die "Can't fork: $!\n";
+ mkpath("$BASE/run/$kvm");
+
+ defined(my $pid = open(VM, "-|")) or die "Can't fork: $!\n";
if ($pid == 0) {
- exec $KVM "kvm-$KVM" => map { split } @config;
+ open(STDERR, ">&STDOUT")
+ or die "Can't redirect STDERR to STDOUT: $!\n";
+ exec $KVM "kvm-$kvm" => map { split " ", $_, 2 } @config;
die "Can't exec: $!";
}
- exit;
+ <VM> ~~ /\s(\S+)$/;
+ symlink($1, "$BASE/run/$kvm/monitor");
+}
+
+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");
+
+ $o->autoflush(1);
+
+ 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;
+ INPUT:
+ while (my @ready = IO::Select->new($i, \*STDIN)->can_read(undef)) {
+ foreach my $fh (@ready) {
+ if ($fh == $i) {
+ sysread($i, $_, 1) == 0
+ and last INPUT;
+ syswrite(STDOUT, $_);
+ if (/\n/ and $row++ >= $rows) {
+ syswrite(STDOUT, "more...");
+ sysread(STDIN, $_, 1);
+ $row = 0;
+ }
+ }
+ elsif ($fh == \*STDIN) {
+ (sysread(STDIN, $_, 1) == 0 or /\e/)
+ and print("\r\n"), last INPUT;
+ syswrite($o, $_);
+ $row = 0;
+ }
+ }
+ }
+ };
+ system("stty $termio");
}
__END__
@@ -95,7 +143,7 @@
=head1 SYNOPSIS
- kvmtool start <name>
+ kvmtool <start|kill|monitor> <name>
=head1 DESCRITPTION