better liveCD support
[os-autoinst:os-autoinst.git] / bmwqemu.pm
1 $|=1;
2
3 package bmwqemu;
4 use strict;
5 use warnings;
6 use Time::HiRes qw(sleep);
7 use Digest::MD5;
8 use Exporter;
9 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
10 @ISA = qw(Exporter);
11 @EXPORT = qw($qemubin $qemupid %cmd 
12 &qemusend &sendkey &sendautotype &autotype &take_screenshot &qemualive &waitidle &waitgoodimage &open_management_console);
13
14
15 our $debug=1;
16 our $qemubin="/usr/bin/kvm";
17 our $qemupid;
18 our $managementcon;
19 our %cmd=qw(
20 next alt-n
21 install alt-i
22 finish alt-f
23 accept alt-a
24 createpartsetup alt-c
25 custompart alt-c
26 addpart alt-d
27 donotformat alt-d
28 addraid alt-i
29 add alt-a
30 raid0 alt-0
31 raid1 alt-1
32 raid6 alt-6
33 raid10 alt-i
34 mountpoint alt-m
35 filesystem alt-s
36 acceptlicense alt-a
37 instdetails alt-d
38 rebootnow alt-n
39 );
40
41 $ENV{INSTLANG}||="us";
42 if($ENV{INSTLANG} eq "de") {
43         $cmd{"next"}="alt-w";
44         $cmd{"createpartsetup"}="alt-e";
45         $cmd{"custompart"}="alt-b";
46         $cmd{"addpart"}="alt-h";
47         $cmd{"finish"}="alt-b";
48         $cmd{"accept"}="alt-r";
49         $cmd{"donotformat"}="alt-n";
50         $cmd{"add"}="alt-h";
51         $cmd{"raid6"}="alt-d";
52         $cmd{"raid10"}="alt-r";
53         $cmd{"mountpoint"}="alt-e";
54 }
55
56 sub diag($)
57 { return unless $debug; print STDERR "@_\n";}
58
59 sub mydie($)
60 { kill(15, $qemupid); print STDERR @_; sleep 1 ; exit 1; }
61
62 sub fileContent($) {my($fn)=@_;
63         open(my $fd, $fn) or return undef;
64         local $/;
65         my $result=<$fd>;
66         close($fd);
67         return $result;
68 }
69
70 sub qemusend($)
71 {
72         print shift(@_)."\n";
73 }
74
75 sub sendkey($)
76 {
77         my $key=shift;
78         qemusend "sendkey $key";
79         sleep(0.05);
80 }
81
82 my %charmap=("."=>"dot", "/"=>"slash", 
83    "\t"=>"tab", "\n"=>"ret", " "=>"spc", "\b"=>"backspace", "\e"=>"esc");
84
85 sub sendautotype($)
86 {
87         my $string=shift;
88         foreach my $letter (split("", $string)) {
89                 if($charmap{$letter}) { $letter=$charmap{$letter} }
90                 sendkey $letter;
91         }
92 }
93
94 sub autotype($)
95 {
96         my $string=shift;
97         my $result="";
98         foreach my $letter (split("", $string)) {
99                 $result.="sendkey $letter\n";
100         }
101         return $result;
102 }
103
104 my $lasttime;
105 my $lastname;
106 my $n=0;
107 my %md5file;
108 my %md5badlist=qw();
109 our %md5goodlist;
110 eval(fileContent("goodimage.pm"));
111 use threads;
112 use threads::shared;
113 my $goodimageseen :shared = 0;
114
115 sub take_screenshot()
116 {
117         my $path="qemuscreenshot/";
118         mkdir $path;
119         if($lastname && -e $lastname) { # processing previous image, because saving takes time
120                 # hardlinking identical files saves space
121                 my $md5=Digest::MD5::md5_hex(fileContent($lastname));
122                 if($md5badlist{$md5}) {diag "error condition detected. test failed. see $lastname"; sleep 1; mydie "bad image seen"}
123                 diag("md5=$md5");
124                 if($md5goodlist{$md5}) {$goodimageseen=1; diag "good image"}
125                 if($md5file{$md5}) {
126                         unlink($lastname); # warning: will break if FS does not support hardlinking
127                         link($md5file{$md5}->[0], $lastname);
128                         my $linkcount=$md5file{$md5}->[1]++;
129                         #my $linkcount=(stat($lastname))[3]; # relies on FS
130                         if($linkcount>530) {mydie "standstill detected. test ended. see $lastname\n"} # above 120s of autoreboot
131                 } else {
132                         $md5file{$md5}=[$lastname,1];
133                 }
134         }
135         my $now=time();
136         if(!$lasttime || $lasttime!=$now) {$n=0};
137         my $filename=$path.$now."-".$n++.".ppm";
138         #print STDERR $filename,"\n";
139         qemusend "screendump $filename";
140         $lastname=$filename;
141         $lasttime=$now;
142 }
143
144 sub qemualive()
145
146 #       if(!$qemupid) {$qemupid=`pidof -s $qemubin`; chomp $qemupid;}
147         return 0 unless $qemupid;
148         kill 0, $qemupid;
149 }
150
151 sub waitidle(;$)
152 {
153         my $timeout=shift||10;
154         my $prev;
155         diag "waitidle(timeout=$timeout)";
156         for my $n (1..$timeout) {
157                 my $stat=fileContent("/proc/$qemupid/stat");
158                         #"/proc/$qemupid/schedstat");
159                 my @a=split(" ", $stat);
160                 $stat=$a[13];
161                 next unless $stat;
162                 #$stat=$a[1];
163                 if($prev) {
164                         my $diff=$stat-$prev;
165                         if($diff<10) { # idle for one sec
166                         #if($diff<2000000) # idle for one sec
167                                 diag "idle detected";
168                                 return 1;
169                         }
170                 }
171                 $prev=$stat;
172                 sleep 1;
173         }
174         diag "waitidle timed out";
175         return 0;
176 }
177
178 sub waitgoodimage($)
179 {
180         my $timeout=shift||10;
181         $goodimageseen=0;
182         diag "waiting for good image(timeout=$timeout)";
183         for my $n (1..$timeout) {
184                 if($goodimageseen) {diag "seen good image... continuing execution"; return 1;}
185                 sleep 1;
186         }
187         return 0;
188 }
189
190
191 use IO::Socket;
192 use threads;
193
194 # read all output from management console and forward it to STDOUT
195 sub readconloop
196 {
197         $|=1;
198         while(<$managementcon>) {
199                 print $_;
200         }
201 }
202
203 sub open_management_console()
204 {
205         $managementcon=IO::Socket::INET->new("localhost:15222") or mydie "error opening management console: $!";
206         our $readconthread=threads->create(\&readconloop); # without this, qemu will block
207         select $managementcon;
208         $|=1; # autoflush
209         $managementcon;
210 }
211
212 1;