# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1250456883 -7200
# Node ID e1956a6cd9283ed512931f73cdbfcadcc34e736b
# Parent  54bfff297ed4ddf011a80ce8505750e75f2d6f80
[code] implemented the monitor command (and option)

diff -r 54bfff297ed4 -r e1956a6cd928 kvmtool
--- 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