15.22KiB, text/plain; utf-8; Perl | Statements 344
1
#!/usr/bin/perl -w
2
# Copyright © 2009-2013 Bernhard M. Wiedemann
3
# Copyright © 2012-2016 SUSE LLC
4
#
5
# This program is free software; you can redistribute it and/or modify
6
# it under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 2 of the License, or
8
# (at your option) any later version.
9
#
10
# This program is distributed in the hope that it will be useful,
11
# but WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License along
16
# with this program; if not, see <http://www.gnu.org/licenses/>.
17
#
18
19
=head1 SYNOPSIS
20
21
isotovideo [OPTIONS]
22
23
Parses vars.json and tests the given assets/ISOs.
24
25
=head1 OPTIONS
26
27
=over 4
28
29
=item B<-d, --debug>
30
31
Enable direct output to STDERR instead of autoinst-log.txt
32
33
=item B<-h, -?, --help>
34
35
Show this help.
36
37
=cut
38
39
use strict;
40
41 1
my $installprefix;    # $bmwqemu::scriptdir
42
43
BEGIN {
44
    # the following line is modified during make install
45
    $installprefix = undef;
46
47
    my ($wd) = $0 =~ m-(.*)/-;
48
    $wd ||= '.';
49
    $installprefix ||= $wd;
50
    unshift @INC, "$installprefix";
51
}
52
53
# this shall be an integer increased by every change of the API
54
# either to the worker or the tests
55
our $INTERFACE = 7;
56
57
use bmwqemu;
58
use needle;
59
use autotest;
60
use commands;
61
use distribution;
62
use testapi 'diag';
63
use Getopt::Long;
64
require IPC::System::Simple;
65
use autodie ':all';
66
no autodie 'kill';
67
use Cwd;
68
use POSIX qw(:sys_wait_h _exit);
69
use Carp 'cluck';
70
use Time::HiRes qw(gettimeofday tv_interval sleep time);
71
use File::Spec;
72
use File::Path;
73
Getopt::Long::Configure("no_ignore_case");
74
75
my %options;
76
# global exit status
77
my $r = 1;
78
79
sub usage {
80
    my ($return_code) = @_;
81
    $r = $return_code;
82 1
    eval { use Pod::Usage; pod2usage($return_code); };
83
    if ($@) {
84
        die "cannot display help, install perl(Pod::Usage)\n";
85
    }
86
}
87
88
sub version {
89
    my $thisversion = qx{git rev-parse HEAD};
90
    print "Current version is $thisversion";
91
    exit 0;
92
}
93
94
GetOptions(\%options, 'debug|d', 'help|h|?', 'version|v') or usage(1);
95
usage(0)  if $options{help};
96
version() if $options{version};
97
98
99
# enable debug default when started from a tty
100
$bmwqemu::direct_output = $options{debug};
101
102
# whether tests completed (or we bailed due to a failed 'fatal' test)
103
my $completed = 0;
104
105 1
select(STDERR);
106
$| = 1;
107 1
select(STDOUT);    # default
108
$| = 1;
109
110
$bmwqemu::scriptdir = $installprefix;
111
bmwqemu::init();
112
113
# Sanity checks
114
die "CASEDIR environment variable not set, unknown test case directory" if !defined $bmwqemu::vars{CASEDIR};
115
die "No scripts in $bmwqemu::vars{CASEDIR}" if !-e "$bmwqemu::vars{CASEDIR}";
116
117
my $cpid;
118
my $testpid;
119
my $cfd;
120
121
my $loop = 1;
122
123
sub kill_commands {
124
    return unless $cpid;
125
    # create a copy as cpid is overwritten by SIGCHLD
126
    my $pid = $cpid;
127
    if (kill('TERM', $pid)) {
128
        diag "awaiting death of commands process";
129
        my $ret = waitpid($pid, 0);
130
        diag "commands process exited: $ret";
131
    }
132
    $cpid = 0;
133
}
134
135
sub kill_autotest {
136
    return unless $testpid;
137
    # create a copy as cpid is overwritten by SIGCHLD
138
    my $pid = $testpid;
139
    if (kill('TERM', $pid)) {
140
        diag "awaiting death of testpid $pid";
141
        my $ret = waitpid($pid, 0);
142
        diag "test process exited: $ret";
143
    }
144
    $testpid = 0;
145
}
146
147
sub kill_backend {
148
    if (defined $bmwqemu::backend && $bmwqemu::backend->{backend_pid}) {
149
        # save the pid in a scalar - signal handlers will reset it
150
        my $bpid = $bmwqemu::backend->{backend_pid};
151
        diag "killing backend process $bpid";
152
        kill('-TERM', $bpid);
153
        waitpid($bpid, 0);
154
        diag("done with backend process");
155
        $bmwqemu::backend->{backend_pid} = 0;
156
    }
157
}
158
159
sub signalhandler {
160
161
    my ($sig) = @_;
162
    diag("signalhandler got $sig - loop $loop");
163
    if ($loop) {
164
        $loop = 0;
165
        return;
166
    }
167
    kill_backend;
168
    kill_commands;
169
    kill_autotest;
170
    _exit(1);
171
}
172
173
sub signalhandler_chld {
174
175
    while ((my $child = waitpid(-1, WNOHANG)) > 0) {
176
        if ($child == $cpid) {
177
            diag("commands webserver died");
178
            $loop = 0;
179
            $cpid = 0;
180
            next;
181
        }
182
        if ($bmwqemu::backend->{backend_pid} && $child == $bmwqemu::backend->{backend_pid}) {
183
            diag("backend $child died");
184
            $bmwqemu::backend->{backend_pid} = 0;
185
            $loop = 0;
186
            next;
187
        }
188
        if ($child == $testpid) {
189
            diag("tests died");
190
            $testpid = 0;
191
            $loop    = 0;
192
            next;
193
        }
194
        diag("unknown child $child died");
195
    }
196
}
197
198
our $test_git_hash;
199
our $needles_git_hash;
200
201
sub init_backend {
202
    my ($name) = @_;
203
    $bmwqemu::vars{BACKEND} ||= "qemu";
204
205
    # make sure the needles are initialized
206
    my $needles_dir = $bmwqemu::vars{PRODUCTDIR} . '/needles';
207
    needle::init($needles_dir);
208
    $needles_git_hash = calculate_git_hash($needles_dir);
209
    $bmwqemu::vars{NEEDLES_GIT_HASH} = $needles_git_hash;
210
211
    $bmwqemu::backend = backend::driver->new($bmwqemu::vars{BACKEND});
212
    return $bmwqemu::backend;
213
}
214
215
sub calculate_git_hash {
216
    my ($git_repo_dir) = @_;
217
    my $dir = getcwd;
218
    chdir($git_repo_dir);
219
    chomp(my $git_hash = qx{git rev-parse HEAD});
220
    $git_hash ||= "UNKNOWN";
221
    chdir($dir);
222
    diag "git hash in $git_repo_dir: $git_hash";
223
    return $git_hash;
224
}
225
226
$SIG{TERM} = \&signalhandler;
227
$SIG{INT}  = \&signalhandler;
228
$SIG{HUP}  = \&signalhandler;
229
$SIG{CHLD} = \&signalhandler_chld;
230
231
# make sure all commands coming from the backend will not be in the
232
# developers's locale - but a defined english one. This is SUSE's
233
# default locale
234
$ENV{LC_ALL} = 'en_US.UTF-8';
235
$ENV{LANG}   = 'en_US.UTF-8';
236
237
# Try to load the main.pm from one of the following in this order:
238
#  - product dir
239
#  - casedir
240
#
241
# This allows further structuring the test distribution collections with
242
# multiple distributions or flavors in one repository.
243
$bmwqemu::vars{PRODUCTDIR} ||= $bmwqemu::vars{CASEDIR};
244
245
# as we are about to load the test modules store the git hash that has been
246
# used. If it is not a git repo fail silently, i.e. store an empty variable
247
248
$test_git_hash = calculate_git_hash($bmwqemu::vars{CASEDIR});
249
# TODO find a better place to store hash in than vars.json, see
250
# https://github.com/os-autoinst/os-autoinst/pull/393#discussion_r50143013
251
$bmwqemu::vars{TEST_GIT_HASH} = $test_git_hash;
252
253
# start the command fork before we get into the backend, the command child
254
# is not supposed to talk to the backend directly
255
($cpid, $cfd) = commands::start_server($bmwqemu::vars{QEMUPORT} + 1);
256
257
# add lib of the test distributions - but only for main.pm not to pollute
258
# further dependencies (the tests get it through autotest)
259 1
my @oldINC = @INC;
260
unshift @INC, $bmwqemu::vars{CASEDIR} . '/lib';
261
require $bmwqemu::vars{PRODUCTDIR} . "/main.pm";
262
@INC = @oldINC;
263
264
if ($bmwqemu::vars{_EXIT_AFTER_SCHEDULE}) {
265
    diag 'Early exit has been requested with _EXIT_AFTER_SCHEDULE. Only evaluating test schedule.';
266
    exit 0;
267
}
268
269
# set a default distribution if the tests don't have one
270
$testapi::distri ||= distribution->new;
271
272
testapi::init();
273
274
# init part
275
bmwqemu::save_vars();
276
277
my $testfd;
278
($testpid, $testfd) = autotest::start_process();
279
280
init_backend();
281
282
open(my $fd, ">", "os-autoinst.pid");
283
print $fd "$$\n";
284
close $fd;
285
286
if (!$bmwqemu::backend->_send_json({cmd => 'alive'})) {
287
    # might throw an exception
288
    $bmwqemu::backend->start_vm();
289
}
290
291
if ($ENV{RUN_VNCVIEWER}) {
292
    system("vncviewer -shared localhost:" . $bmwqemu::vars{VNC} . " -viewonly &");
293
}
294
if ($ENV{RUN_DEBUGVIEWER}) {
295
    system("$bmwqemu::scriptdir/debugviewer/debugviewer qemuscreenshot/last.png &");
296
}
297
298
use IO::Select;
299
300
my $s = IO::Select->new();
301
$s->add($testfd);
302
$s->add($cfd);
303
$s->add($bmwqemu::backend->{from_child});
304
305
# now we have everything, give the tests a go
306
$testfd->write("GO\n");
307
308
my $interactive = 0;
309
my $needinput   = 0;
310
311
my $current_test_name;
312
313
# timeout for the select (only set for check_screens)
314
my $timeout = undef;
315
316
# do not wait for timeout if set
317
my $no_wait = undef;
318
319
# marks a running check_screen
320
our $tags = undef;
321
322
# set to the socket we have to send replies to when the backend is done
323
my $backend_requester = undef;
324
325
my ($last_check_seconds, $last_check_microseconds) = gettimeofday;
326
sub _calc_check_delta {
327
    # an estimate of eternity
328
    my $delta = 100;
329
    if ($last_check_seconds) {
330
        $delta = tv_interval([$last_check_seconds, $last_check_microseconds], [gettimeofday]);
331
    }
332
    if ($delta > 0) {
333
        # sleep the remains of one second
334
        $timeout = 1 - $delta;
335
        $timeout = 0 if $timeout < 0;
336
    }
337
    else {
338
        $timeout = 0;
339
    }
340
    return $delta;
341
}
342
343
sub check_asserted_screen {
344 1
    my ($force_timeout, $no_wait) = @_;
345
346
    if ($no_wait) {
347
        # prevent CPU overload by waiting at least a little bit
348
        $timeout = 0.1;
349
    }
350
    else {
351
        _calc_check_delta;
352
        # come back later, avoid too often called function
353
        return if $timeout > 0.05;
354
    }
355
    ($last_check_seconds, $last_check_microseconds) = gettimeofday;
356
    my $rsp = $bmwqemu::backend->_send_json({cmd => 'check_asserted_screen'}) || {};
357
    # the test needs that information
358
    $rsp->{tags} = $tags;
359
    if ($rsp->{found}) {
360
        myjsonrpc::send_json($testfd, {ret => $rsp});
361
        $tags = $timeout = undef;
362
    }
363
    elsif ($rsp->{timeout}) {
364
        if ($interactive && !$force_timeout) {
365
            # now get fancy
366
            $bmwqemu::backend->_send_json({cmd => 'freeze_vm'});
367
            $rsp->{saveresult} = 1;
368
            myjsonrpc::send_json($testfd, {ret => $rsp});
369
            $needinput = 1;
370
        }
371
        else {
372
            myjsonrpc::send_json($testfd, {ret => $rsp});
373
            $tags = undef;
374
        }
375
        $timeout = undef;
376
    }
377
    else {
378
        _calc_check_delta unless $no_wait;
379
    }
380
}
381
382
$r = 0;
383
384
while ($loop) {
385
    my ($reads, $writes, $exceps) = IO::Select::select($s, undef, $s, $timeout);
386
    for my $r (@$reads) {
387
        my $rsp = myjsonrpc::read_json($r);
388
        if (!defined $rsp) {
389
            diag sprintf("THERE IS NOTHING TO READ %d %d %d", fileno($r), fileno($testfd), fileno($cfd));
390
            $r    = 1;
391
            $loop = 0;
392
            last;
393
        }
394
        if ($r == $bmwqemu::backend->{from_child}) {
395
            myjsonrpc::send_json($backend_requester, {ret => $rsp->{rsp}});
396
            $backend_requester = undef;
397
            next;
398
        }
399
        if ($rsp->{cmd} =~ m/^backend_(.*)/) {
400
            die "we need to implement a backend queue" if $backend_requester;
401
            $backend_requester = $r;
402
            my $cmd = $1;
403
            delete $rsp->{cmd};
404
            myjsonrpc::send_json($bmwqemu::backend->{to_child}, {cmd => $cmd, arguments => $rsp});
405
            next;
406
        }
407
        if ($rsp->{cmd} eq 'set_current_test') {
408
            $bmwqemu::backend->_send_json({cmd => 'set_serial_offset'});
409
            $current_test_name = $rsp->{name};
410
            myjsonrpc::send_json($r, {ret => 1});
411
            next;
412
        }
413
        if ($rsp->{cmd} eq 'tests_done') {
414
            $r         = $rsp->{died};
415
            $completed = $rsp->{completed};
416
            CORE::close($testfd);
417
            $testfd = undef;
418
            kill_autotest;
419
            $loop = 0;
420
            next;
421
        }
422
        if ($rsp->{cmd} eq 'check_screen') {
423
            $no_wait = $rsp->{no_wait} // 0;
424
425
            $tags = $bmwqemu::backend->_send_json(
426
                {
427
                    cmd       => 'set_tags_to_assert',
428
                    arguments => {
429
                        mustmatch => $rsp->{mustmatch},
430
                        timeout   => $rsp->{timeout},
431
                        check     => $rsp->{check}}})->{tags};
432
            next;
433
        }
434
435
        ##### HTTP commands
436
        if ($rsp->{cmd} eq 'status') {
437
            my $result = {tags => $tags, running => $current_test_name};
438
            $result->{interactive} = $interactive;
439
            $result->{needinput}   = $needinput;
440
            myjsonrpc::send_json($r, $result);
441
            next;
442
        }
443
444
        if ($rsp->{cmd} eq 'version') {
445 1
            my $result = {test_git_hash => $test_git_hash, needles_git_hash => $needles_git_hash, version => $INTERFACE};
446
            myjsonrpc::send_json($r, $result);
447
            next;
448
        }
449
450
        if ($rsp->{cmd} eq 'interactive') {
451
            # interactive is boolean
452
            $interactive = $rsp->{params}->{state} ? 1 : 0;
453
            if (!$interactive && $needinput) {
454
                # need to continue the VM
455
                $bmwqemu::backend->_send_json({cmd => 'retry_assert_screen'});
456
                $needinput = 0;
457
                $timeout   = .1;
458
                check_asserted_screen(1, $no_wait);
459
            }
460
            myjsonrpc::send_json($r, {interactive => $interactive});
461
            next;
462
        }
463
464
        if ($rsp->{cmd} eq 'stop_waitforneedle') {
465
            $bmwqemu::backend->_send_json({cmd => 'reduce_deadline'});
466
            myjsonrpc::send_json($r, {ret => 0});
467
            next;
468
        }
469
        if ($rsp->{cmd} eq 'continue_waitforneedle' || $rsp->{cmd} eq 'reload_needles') {
470
            $needinput = 0;
471
            $timeout   = .1;
472
            my $reload = $rsp->{cmd} eq 'reload_needles';
473
            # tell backend to retry
474
            $bmwqemu::backend->_send_json({cmd => 'retry_assert_screen', arguments => {reload_needles => $reload}});
475
            # that's enough for the webui to know
476
            myjsonrpc::send_json($r, {ret => 0});
477
            check_asserted_screen(1, $no_wait);
478
            next;
479
        }
480
        die "Unknown command $rsp->{cmd}";
481
    }
482
483
    if (defined $tags && !$needinput) {
484
        check_asserted_screen(0, $no_wait);
485
    }
486
}
487
488
# don't leave the commands server open - it will no longer react anyway
489
# as most of it ends up in the loop above
490
kill_commands;
491
492
if ($testfd) {
493
    $r = 1;    # unusual shutdown
494
    CORE::close $testfd;
495
    kill_autotest;
496
}
497
498
diag "isotovideo " . ($r ? 'failed' : 'done');
499
500
my $clean_shutdown;
501
if (!$r) {
502
    eval {
503
        $clean_shutdown = $bmwqemu::backend->_send_json({cmd => 'is_shutdown'});
504
        diag "BACKEND SHUTDOWN $clean_shutdown";
505
    };
506
    # don't rely on the backend in a sane state if we failed - just kill it later
507
    eval { bmwqemu::stop_vm(); };
508
    if ($@) {
509
        diag "Error during stop_vm: $@";
510
        $r = 1;
511
    }
512
}
513
514
# read calculated variables from backend and tests
515
bmwqemu::load_vars();
516
517
# mark hard disks for upload if test finished
518
if (!$r && $completed && (my $nd = $bmwqemu::vars{NUMDISKS}) && ($bmwqemu::vars{BACKEND} eq 'qemu')) {
519
    my @toextract;
520
    for my $i (1 .. $nd) {
521
        my $dir = 'assets_private';
522
        my $name = $bmwqemu::vars{"STORE_HDD_$i"} || undef;
523
        unless ($name) {
524
            $name = $bmwqemu::vars{"PUBLISH_HDD_$i"} || undef;
525
            $dir = 'assets_public';
526
        }
527
        next unless $name;
528
        $name =~ /\.([[:alnum:]]+)$/;
529 1
        my $format = $1;
530
        push @toextract, {hdd_num => $i, name => $name, dir => $dir, format => $format};
531
    }
532
    if (@toextract && !$clean_shutdown) {
533
        diag "ERROR: Machine not shut down when uploading disks!\n";
534
        $r = 1;
535
    }
536
    else {
537
        for my $asset (@toextract) {
538
            $bmwqemu::backend->extract_assets($asset);
539
        }
540
    }
541
}
542
543
END {
544
    kill_backend;
545
    kill_commands;
546
    kill_autotest;
547
    # in case of early exit, e.g. help display
548
    $r //= 0;
549
    print "$$: EXIT $r\n";
550
    $? = $r;
551
}
552
553
# vim: set sw=4 et: