aboutsummaryrefslogtreecommitdiffstats
path: root/virsh-ga
blob: d64983cf0db65086dbc92f3af9b5590a070b9cbd (plain)
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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
#!/usr/bin/perl

# Send command to a guest's QEMU Agent to access its file.
# Usage: virsh-ga [--connect=URI] DOMAIN COMMAND [ARGUMENT..]
#
# Return value:
#   - 0 on success,
#   - 128 if the QEMU agent is not connected, and
#   - 1 on error.


# Clean up PATH
$ENV{PATH} = join ':', qw{/usr/bin /bin};
delete @ENV{qw/IFS CDPATH ENV BASH_ENV/};

use warnings;
use strict;

use Symbol 'gensym';
use IO::Select ();
use IPC::Open3 'open3';
use JSON ();
use MIME::Base64 'decode_base64';
use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version auto_help/;

my %OPTIONS;
GetOptions(\%OPTIONS, qw/connect|c=s/) or die;
my $DOMAIN  = shift // die;
my $COMMAND = shift // die;

my @VIRSH = ('virsh');
push @VIRSH, '--connect='.$OPTIONS{connect} if defined $OPTIONS{connect};

sub ga_send(@) {
    my @command = (@VIRSH, 'qemu-agent-command', '--block', $DOMAIN, JSON->new->encode({ @_ }));
    my $pid = open3(my $in, my $out, my $err = gensym(), @command);
    my $sel = IO::Select::->new($out, $err);
    my %str;
    while (my @fhs = $sel->can_read) {
        foreach my $fh (@fhs) {
            my $x = $fh->getline;
            if (defined $x) {
                $str{$fh} .= $x;
            } else {
                $sel->remove($fh);
            }
        }
    }
    waitpid $pid, 0;
    close $_ foreach ($in, $out, $err);
    if ($? == 0) {
        my $h = JSON->new->utf8->allow_nonref->decode($str{$out});
        return $h->{return};
    }
    elsif ($str{$err} eq "error: Guest agent is not responding: QEMU guest agent is not connected\n"
        or $str{$err} eq "error: Guest agent is not responding: Guest agent not available for now\n"
        or $str{$err} =~ /\Aerror: internal error: Guest agent returned ID: \d+ instead of \d+\n\z/) {
        exit 128;
    } else {
        die $str{$err};
    }
}

# the JSON domain definition can be found in QEMU's qga/qapi-schema.json
if ($COMMAND eq 'info') {
    my $r = ga_send(execute => 'guest-info');
    print JSON->new->pretty->utf8->canonical->encode($r), "\n";
}
elsif ($COMMAND eq 'ping') {
    ga_send(execute => 'guest-ping');
}
elsif ($COMMAND eq 'cat') {
    die unless @ARGV;
    foreach my $path (@ARGV) {
        my $fh = ga_send(execute => 'guest-file-open', arguments => {path => $path, mode => 'r'});

        my ($b64, $eof);
        do {
            # keep reading until we reach EOF
            my $r = ga_send(execute => 'guest-file-read', arguments => {handle => $fh});
            $b64 .= $r->{'buf-b64'};
            $eof = $r->{eof};
        } until ($eof);
        print decode_base64($b64);

        ga_send(execute => 'guest-file-close', arguments => {handle => $fh});
    }
}
elsif ($COMMAND eq 'touch') {
    die unless @ARGV;
    foreach my $path (@ARGV) {
        my $fh = ga_send(execute => 'guest-file-open', arguments => {path => $path, mode => 'a'});
        ga_send(execute => 'guest-file-close', arguments => {handle => $fh});
    }
}