vbox: implement do_stop_vm
[os-autoinst:os-autoinst.git] / backend / vbox.pm
1 #!/usr/bin/perl -w
2
3 package backend::vbox;
4 use strict;
5 use Cwd 'abs_path';
6
7 #use FindBin;
8 #use lib "$FindBin::Bin/backend";
9 #use lib "$FindBin::Bin/backend/helper";
10 #use lib "$FindBin::Bin/helper";
11 use base ('backend::helper::scancodes', 'backend::baseclass');
12
13 our $scriptdir = $bmwqemu::scriptdir || '.';
14
15 sub init() {
16         my $self = shift;
17         $self->{'vmname'} = 'osautoinst';
18         $self->{'pid'} = undef;
19         $self->backend::helper::scancodes::init();
20 }
21
22
23 # scancode virt method overwrite
24
25 sub keycode_down($) {
26         my $self = shift;
27         my $key = shift;
28         my $keycode = $self->{'keymaps'}->{'vbox'}->{$key};
29         if($keycode>=0x80) {return (0xe0, $keycode ^ 0x80);}
30         return ($keycode);
31 }
32
33 sub keycode_up($) {
34         my $self = shift;
35         my $key = shift;
36         my $keycode = $self->{'keymaps'}->{'vbox'}->{$key};
37         if($keycode>=0x80) {return (0xe0, $keycode);}
38         return ($keycode ^ 0x80);
39 }
40
41 sub raw_keyboard_io($) {
42         my $self = shift;
43         my $data = shift;
44         my @codes = map(sprintf("%02x", $_), @$data);
45         $self->raw_vbox_controlvm("keyboardputscancode", @codes);
46 }
47
48 # scancode virt method overwrite end
49
50
51 # baseclass virt method overwrite
52
53 sub screendump($) {
54         my $self = shift;
55         my $filename = shift;
56         my $r = int(rand(1e9));
57         my $tmp = "/tmp/vbox-$r.png";
58         $self->raw_vbox_controlvm("screenshotpng", $tmp);
59         system("convert", $tmp, $filename);
60         unlink $tmp;
61 }
62
63 sub power($) {
64         # parameters:
65         # acpi, reset, off
66         my $self = shift;
67         my $action = shift;
68         if ($action eq 'acpi') {
69                 $self->raw_vbox_controlvm("acpipowerbutton");
70         }
71         elsif ($action eq 'reset') {
72                 $self->raw_vbox_controlvm("reset");
73         }
74         elsif ($action eq 'off') {
75                 $self->raw_vbox_controlvm("poweroff");
76         }
77 }
78
79 #sub mouse_move($) { ( move / set)
80 #       # TODO ( move / set)
81 #       # not too bad because cursor does not appear on screenshot
82 #}
83
84 #sub mouse_button($) {
85 #       # TODO
86 #}
87
88 sub insert_cd($) {
89         my $self = shift;
90         my $iso = shift;
91         system(qq'VBoxManage storageattach '.$self->{vmname}.' --storagectl "IDE Controller" --port 1 --device 0 --type dvddrive --medium '.$iso);
92 }
93
94 sub eject_cd($) {
95         my $self = shift;
96         system(qq'VBoxManage storageattach '.$self->{'vmname'}.' --storagectl "IDE Controller" --port 1 --device 0 --type dvddrive --medium emptydrive');
97 }
98
99 sub start_audiocapture($) {
100         my $self = shift;
101         my $wavfilename = shift;
102         system("$scriptdir/tools/pawav.pl $wavfilename &");
103 }
104
105 sub stop_audiocapture($) {
106         system("killall", "parec");
107 }
108
109 sub raw_alive($) {
110         my $self = shift;
111         return 0 unless $self->{'pid'};
112         return kill(0, $self->{'pid'});
113 }
114
115 sub do_start_vm {
116         my $self = shift;
117         $self->raw_vbox_controlvm("poweroff"); # stop if running
118         # TODO: assemble VM with ISO and disks similar to startqemu.pm
119         # attach iso as DVD:
120         $self->insert_cd($ENV{ISO});
121         # pipe serial console output to file:
122         system("VBoxManage", "modifyvm", $self->{vmname}, "--uartmode1", "file", abs_path("serial0"));
123         system("VBoxManage", "modifyvm", $self->{vmname}, "--uart1", "0x3f8", 4);
124         system("VBoxManage", "startvm", $self->{vmname});
125         my $pid=`pidof VirtualBox`; chomp($pid);
126         $pid=~s/ .*//; # use first pid, in case GUI was open
127         $self->{'pid'} = $pid;
128         #return 1;
129         return(($?>>8)==0);
130 }
131
132 sub do_stop_vm {
133         my $self = shift;
134         $self->raw_vbox_controlvm("poweroff");
135 }
136
137 # baseclass virt method overwrite end
138
139
140 sub raw_vbox_controlvm($) {
141         my $self = shift;
142         system("VBoxManage", "controlvm", $self->{'vmname'}, @_);
143 }
144
145 1;