virt-sandbox.pl 1.03 KB
Newer Older
1 2 3 4 5 6
#!/usr/bin/perl

use strict;
use warnings;
use Glib::Object::Introspection;

7 8
Glib::Object::Introspection->setup(basename => 'GLib', version => '2.0', package => 'GLib');
Glib::Object::Introspection->setup(basename => 'Gtk', version => '3.0', package => 'Gtk');
9 10 11 12 13
Glib::Object::Introspection->setup(basename => 'LibvirtGObject', version => '1.0', package => 'LibvirtGObject');
Glib::Object::Introspection->setup(basename => 'LibvirtSandbox', version => '1.0', package => 'LibvirtSandbox');

LibvirtGObject::init_object_check(undef);

14
my $cfg = LibvirtSandbox::ConfigInteractive->new("sandbox");
15 16 17 18 19
if (int(@ARGV) > 0) {
    $cfg->set_command(@ARGV);
}
if (-t STDIN) {
    $cfg->set_tty(1);
20 21
}

22 23 24
my $conn = LibvirtGObject::Connection->new("qemu:///session");
$conn->open(undef);

25
my $ctxt = LibvirtSandbox::ContextInteractive->new($conn, $cfg);
26
$ctxt->start();
27 28 29

my $con = $ctxt->get_console();

30 31 32
sub closed {
    Gtk::main_quit();
}
33

34
$con->connect("closed", \&closed);
35 36 37 38
$con->attach_stdio();

Gtk::main();

39 40 41 42 43 44
eval {
    $con->detach();
};
eval {
    $ctxt->stop();
};