8.59KiB, text/plain; utf-8; Perl | Statements 201
1
# Copyright © 2009-2013 Bernhard M. Wiedemann
2
# Copyright © 2012-2015 SUSE LLC
3
#
4
# This program is free software; you can redistribute it and/or modify
5
# it under the terms of the GNU General Public License as published by
6
# the Free Software Foundation; either version 2 of the License, or
7
# (at your option) any later version.
8
#
9
# This program is distributed in the hope that it will be useful,
10
# but WITHOUT ANY WARRANTY; without even the implied warranty of
11
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
# GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License along
15
# with this program; if not, see <http://www.gnu.org/licenses/>.
16
17 1
package bmwqemu;
18
use strict;
19
use warnings;
20
use Time::HiRes qw(sleep gettimeofday);
21
use IO::Socket;
22
use Fcntl ':flock';
23
24
use POSIX;
25
use Carp;
26
use JSON;
27
use File::Path 'remove_tree';
28
use Data::Dumper;
29
use Mojo::Log;
30
use File::Spec::Functions;
31
use base 'Exporter';
32
use Exporter;
33
use POSIX 'strftime';
34
use Time::HiRes 'gettimeofday';
35
our $VERSION;
36
our @EXPORT    = qw(fileContent save_vars);
37
our @EXPORT_OK = qw(diag);
38
39
use backend::driver;
40
require IPC::System::Simple;
41
use autodie ':all';
42
43
sub mydie;
44
45
$| = 1;
46
47
48
our $default_timeout = 30;    # assert timeout, 0 is a valid timeout
49
50
my @ocrrect;
51
52
our $screenshotpath = "qemuscreenshot";
53
54
# global vars
55
56
our $logger;
57
58
our $direct_output;
59
60
# Known locations of OVMF (UEFI) firmware: first is openSUSE, second is
61
# the kraxel.org nightly packages, third is Fedora's edk2-ovmf package,
62
# fourth is Debian's ovmf package.
63
our @ovmf_locations = (
64
    '/usr/share/qemu/ovmf-x86_64-ms.bin', '/usr/share/edk2.git/ovmf-x64/OVMF_CODE-pure-efi.fd',
65
    '/usr/share/edk2/ovmf/OVMF_CODE.fd',  '/usr/share/OVMF/OVMF_CODE.fd'
66
);
67
68
our %vars;
69
70
sub load_vars {
71
    my $fn  = "vars.json";
72
    my $ret = {};
73
    local $/;
74
    open(my $fh, '<', $fn) or return 0;
75
    eval { $ret = JSON->new->relaxed->decode(<$fh>); };
76
    die "parse error in vars.json:\n$@" if $@;
77
    close($fh);
78
    %vars = %{$ret};
79
    return;
80
}
81
82
sub save_vars {
83
    my $fn = "vars.json";
84
    unlink "vars.json" if -e "vars.json";
85
    open(my $fd, ">", $fn);
86
    flock($fd, LOCK_EX) or die "cannot lock vars.json: $!\n";
87
    truncate($fd, 0) or die "cannot truncate vars.json: $!\n";
88
89
    # make sure the JSON is sorted
90
    my $json = JSON->new->pretty->canonical;
91
    print $fd $json->encode(\%vars);
92
    close($fd);
93
    return;
94
}
95
96
sub result_dir {
97
    return "testresults";
98
}
99
100
our $gocrbin = "/usr/bin/gocr";
101
102
# set from isotovideo during initialization
103
our $scriptdir;
104
105
sub init {
106
    load_vars();
107
108
    $bmwqemu::vars{BACKEND} ||= "qemu";
109
110
    # remove directories for asset upload
111
    remove_tree("assets_public");
112
    remove_tree("assets_private");
113
114
    remove_tree(result_dir);
115
    mkdir result_dir;
116
    mkdir join('/', result_dir, 'ulogs');
117
118
    if ($direct_output) {
119
        $logger = Mojo::Log->new(level => 'debug');
120
    }
121
    else {
122
        $logger = Mojo::Log->new(level => 'debug', path => catfile(result_dir, 'autoinst-log.txt'));
123
    }
124
125
    $logger->format(
126
        sub {
127
            my ($time, $level, @lines) = @_;
128
            # Unfortunately $time doesn't have the precision we want. So we need to use Time::HiRes
129
            $time = gettimeofday;
130 1
            return sprintf(strftime("[%FT%T.%%04d %Z] [$level] ", localtime($time)), 1000 * ($time - int($time))) . join("\n", @lines, '');
131
132
        });
133
134
    die "CASEDIR variable not set in vars.json, unknown test case directory" if !$vars{CASEDIR};
135
136
    unless ($vars{PRJDIR}) {
137
        if (index($vars{CASEDIR}, '/var/lib/openqa/share') != 0) {
138
            die "PRJDIR not specified and CASEDIR ($vars{CASEDIR}) does not appear to be a
139
                subdir of default (/var/lib/openqa/share). Please specify PRJDIR in vars.json";
140
        }
141
        $vars{PRJDIR} = '/var/lib/openqa/share';
142
    }
143
144
145
    # defaults
146 1
    $vars{QEMUPORT} ||= 15222;
147
    $vars{VNC}      ||= 90;
148
    # openQA already sets a random string we can reuse
149
    $vars{JOBTOKEN} ||= random_string(10);
150
151
    save_vars();
152
153
    ## env vars end
154
155
    ## some var checks
156
    if ($gocrbin && !-x $gocrbin) {
157
        $gocrbin = undef;
158
    }
159
    if ($vars{SUSEMIRROR} && $vars{SUSEMIRROR} =~ s{^(\w+)://}{}) {    # strip & check proto
160
        if ($1 ne "http") {
161
            die "only http mirror URLs are currently supported but found '$1'.";
162
        }
163
    }
164
165
}
166
167
## some var checks end
168
169
# global vars end
170
171
# local vars
172
173
our $backend;    #FIXME: make local after adding frontend-api to bmwqemu
174
175
# local vars end
176
177
# global/shared var set functions
178
179
sub set_ocr_rect {
180
    @ocrrect = @_;
181
    return;
182
}
183
184
# global/shared var set functions end
185
186
# util and helper functions
187
188
sub log_format_callback {
189
    my ($time, $level, @lines) = @_;
190
    # Unfortunately $time doesn't have the precision we want. So we need to use Time::HiRes
191
    $time = gettimeofday;
192 1
    return sprintf(strftime("[%FT%T.%%04d %Z] [$level] ", localtime($time)), 1000 * ($time - int($time))) . join("\n", @lines, '');
193
}
194
195
sub diag {
196
    $logger = Mojo::Log->new(level => 'debug', format => \&log_format_callback) unless $logger;
197
    $logger->debug("@_");
198
    return;
199
}
200
201
sub fctres {
202
    my ($text, $fname) = @_;
203
204
    $fname //= (caller(1))[3];
205
    $logger = Mojo::Log->new(level => 'debug', format => \&log_format_callback) unless $logger;
206
    $logger->debug(">>> $fname: $text");
207
    return;
208
}
209
210
sub fctinfo {
211
    my ($text, $fname) = @_;
212
213
    $fname //= (caller(1))[3];
214
    $logger = Mojo::Log->new(level => 'debug', format => \&log_format_callback) unless $logger;
215
    $logger->info("::: $fname: $text");
216
    return;
217
}
218
219
sub fctwarn {
220
    my ($text, $fname) = @_;
221
222
    $fname //= (caller(1))[3];
223
    $logger = Mojo::Log->new(level => 'debug', format => \&log_format_callback) unless $logger;
224
    $logger->warn("!!! $fname: $text");
225
    return;
226
}
227
228
sub modstart {
229
    my ($text, $fname) = @_;
230
    $logger = Mojo::Log->new(level => 'debug', format => \&log_format_callback) unless $logger;
231
    $logger->debug("||| $text $fname");
232
    return;
233
}
234
235
use autotest '$current_test';
236
sub current_test {
237
    return $autotest::current_test;
238
}
239
240
sub update_line_number {
241
    return unless current_test;
242
    return unless current_test->{script};
243
    my $out    = "";
244
    my $ending = quotemeta(current_test->{script});
245
    for my $i (1 .. 10) {
246 1
        my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller($i);
247
        last unless $filename;
248
        next unless $filename =~ m/$ending$/;
249
        $logger->debug("$filename:$line called $subroutine");
250
        last;
251
    }
252
    return;
253
}
254
255
# pretty print like Data::Dumper but without the "VAR1 = " prefix
256
sub pp {
257
    # FTR, I actually hate Data::Dumper.
258
    my $value_with_trailing_newline = Data::Dumper->new(\@_)->Terse(1)->Dump();
259
    chomp($value_with_trailing_newline);
260
    return $value_with_trailing_newline;
261
}
262
263
sub log_call {
264
    my $fname = (caller(1))[3];
265
    update_line_number();
266
    my @result;
267
    while (my ($key, $value) = splice(@_, 0, 2)) {
268
        push @result, join("=", $key, pp($value));
269
    }
270
    my $params = join(", ", @result);
271
    $logger = Mojo::Log->new(level => 'debug', format => \&log_format_callback) unless $logger;
272
    $logger->debug('<<< ' . $fname . "($params)");
273
    return;
274
}
275
276 1
sub fileContent {
277
    my ($fn) = @_;
278
    no autodie 'open';
279
    open(my $fd, "<", $fn) or return;
280
    local $/;
281
    my $result = <$fd>;
282
    close($fd);
283
    return $result;
284
}
285
286
# util and helper functions end
287
288
# backend management
289
290
sub stop_vm {
291
    return unless $backend;
292
    my $ret = $backend->stop();
293
    return $ret;
294
}
295
296
sub mydie {
297
    my ($cause_of_death) = @_;
298
    log_call(cause_of_death => $cause_of_death);
299
    croak "mydie";
300
}
301
302
# runtime information gathering functions end
303
304
305
# store the obj as json into the given filename
306
sub save_json_file {
307
    my ($result, $fn) = @_;
308
309
    open(my $fd, ">", "$fn.new");
310
    print $fd to_json($result, {pretty => 1});
311
    close($fd);
312
    return rename("$fn.new", $fn);
313
}
314
315
sub scale_timeout {
316
    my ($timeout) = @_;
317
    return $timeout * ($vars{TIMEOUT_SCALE} // 1);
318
}
319
320
=head2 random_string
321
322
  random_string([$count]);
323
324
Just a random string useful for pseudo security or temporary files.
325
=cut
326
sub random_string {
327
    my ($count) = @_;
328
    $count //= 4;
329
    my $string;
330
    my @chars = ('a' .. 'z', 'A' .. 'Z');
331
    $string .= $chars[rand @chars] for 1 .. $count;
332
    return $string;
333
}
334
335
sub hashed_string {
336
    fctwarn '@DEPRECATED: Use testapi::hashed_string instead';
337
    return testapi::hashed_string(@_);
338
}
339
340
sub wait_for_one_more_screenshot {
341
    # sleeping for one second should ensure that one more screenshot is taken
342
    # uncoverable subroutine
343
    # uncoverable statement
344
    sleep 1;
345
}
346
347
1;
348
349
# vim: set sw=4 et: