File: virt-sandbox.pl

package info (click to toggle)
libvirt-sandbox 0.5.1%2Bgit20160404-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 3,104 kB
  • ctags: 1,964
  • sloc: ansic: 12,696; python: 2,110; makefile: 447; sh: 302; xml: 151; perl: 110
file content (44 lines) | stat: -rwxr-xr-x 1,055 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
#!/usr/bin/perl

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

Glib::Object::Introspection->setup(basename => 'GLib', version => '2.0', package => 'GLib');
Glib::Object::Introspection->setup(basename => 'Gtk', version => '3.0', package => 'Gtk');
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);

my $cfg = LibvirtSandbox::ConfigInteractive->new("sandbox");
if (int(@ARGV) > 0) {
    $cfg->set_command(@ARGV);
}
if (-t STDIN) {
    $cfg->set_tty(1);
}

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

my $ctxt = LibvirtSandbox::ContextInteractive->new($conn, $cfg);
$ctxt->start();

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

sub closed {
    Gtk::main_quit();
}

$con->connect("closed", \&closed);
$con->attach_stdio();

Gtk::main();

eval {
    $con->detach();
};
eval {
    $ctxt->stop();
};