line |
stmt |
code |
1
|
|
# Copyright 2018-2021 SUSE LLC |
2
|
|
# SPDX-License-Identifier: GPL-2.0-or-later |
3
|
|
|
4
|
|
use Mojo::Base -base, -signatures; |
5
|
63
|
use Mojo::URL; |
|
63
|
|
|
63
|
|
6
|
63
|
use Mojo::File qw(path); |
|
63
|
|
|
63
|
|
7
|
63
|
|
|
63
|
|
|
63
|
|
8
|
|
use Exporter 'import'; |
9
|
63
|
use Cwd; |
|
63
|
|
|
63
|
|
10
|
63
|
use bmwqemu; |
|
63
|
|
|
63
|
|
11
|
63
|
use autotest; |
|
63
|
|
|
63
|
|
12
|
63
|
use Try::Tiny; |
|
63
|
|
|
63
|
|
13
|
63
|
|
|
63
|
|
|
63
|
|
14
|
|
our @EXPORT_OK = qw(checkout_git_repo_and_branch checkout_git_refspec |
15
|
|
handle_generated_assets load_test_schedule); |
16
|
|
|
17
|
|
my $dir = getcwd(); |
18
|
42
|
chdir($git_repo_dir); |
|
42
|
|
|
42
|
|
19
|
42
|
chomp(my $git_hash = qx{git rev-parse HEAD ||:}); |
20
|
42
|
$git_hash ||= "UNKNOWN"; |
21
|
42
|
chdir($dir); |
22
|
42
|
bmwqemu::diag "git hash in $git_repo_dir: $git_hash"; |
23
|
42
|
return $git_hash; |
24
|
42
|
} |
25
|
42
|
|
26
|
|
=head2 checkout_git_repo_and_branch |
27
|
|
|
28
|
|
checkout_git_repo_and_branch($dir [, clone_depth => <num>]); |
29
|
|
|
30
|
|
Takes a test or needles distribution directory parameter and checks out the |
31
|
|
referenced git repository into a local working copy with an additional, |
32
|
|
optional git refspec to checkout. The git clone depth can be specified in the |
33
|
|
argument C<clone_depth> which defaults to 1. |
34
|
|
|
35
|
|
=cut |
36
|
|
my $dir = $bmwqemu::vars{$dir_variable}; |
37
|
|
return undef unless defined $dir; |
38
|
54
|
|
|
54
|
|
|
54
|
|
|
54
|
|
39
|
54
|
my $url = Mojo::URL->new($dir); |
40
|
54
|
return undef unless $url->scheme; # assume we have a remote git URL to clone only if this looks like a remote URL |
41
|
|
|
42
|
29
|
$args{clone_depth} //= 1; |
43
|
29
|
|
44
|
|
my $branch = $url->fragment; |
45
|
4
|
my $clone_url = $url->fragment(undef)->to_string; |
46
|
|
my $local_path = $url->path->parts->[-1] =~ s/\.git$//r; |
47
|
4
|
my $clone_cmd = 'env GIT_SSH_COMMAND="ssh -oBatchMode=yes" git clone'; |
48
|
4
|
my $clone_args = "--depth $args{clone_depth}"; |
49
|
4
|
my $branch_args = ''; |
50
|
4
|
my ($return_code, @out); |
51
|
4
|
my $handle_output = sub { |
52
|
4
|
bmwqemu::diag "@out" if @out; |
53
|
4
|
die "Unable to clone Git repository '$dir' specified via $dir_variable (see log for details)" unless $return_code == 0; |
54
|
|
}; |
55
|
3
|
if ($branch) { |
56
|
3
|
bmwqemu::fctinfo "Checking out git refspec/branch '$branch'"; |
57
|
4
|
$branch_args = " --branch $branch"; |
58
|
4
|
} |
59
|
4
|
if (!-e $local_path) { |
60
|
4
|
bmwqemu::fctinfo "Cloning git URL '$clone_url' to use as test distribution"; |
61
|
|
@out = qx{$clone_cmd $clone_args $branch_args $clone_url 2>&1}; |
62
|
4
|
$return_code = $?; |
63
|
3
|
if ($branch && grep /warning: Could not find remote branch/, @out) { |
64
|
3
|
# maybe we misspelled or maybe someone gave a commit hash instead |
65
|
3
|
# for which we need to take a different approach by downloading the |
66
|
3
|
# repository in the necessary depth until we can reach the commit |
67
|
|
# References: |
68
|
|
# * https://stackoverflow.com/questions/18515488/how-to-check-if-the-commit-exists-in-a-git-repository-by-its-sha-1 |
69
|
|
# * https://stackoverflow.com/questions/26135216/why-isnt-there-a-git-clone-specific-commit-option |
70
|
|
bmwqemu::diag "Fetching more remote objects to ensure availability of '$branch'"; |
71
|
|
@out = qx{$clone_cmd $clone_args $clone_url 2>&1}; |
72
|
|
$return_code = $?; |
73
|
2
|
$handle_output->(); |
74
|
2
|
while (qx[git -C $local_path cat-file -e $branch^{commit} 2>&1] =~ /Not a valid object/) { |
75
|
2
|
$args{clone_depth} *= 2; |
76
|
2
|
@out = qx[git -C $local_path fetch --progress --depth=$args{clone_depth} 2>&1]; |
77
|
2
|
$return_code = $?; |
78
|
5
|
bmwqemu::diag "git fetch: @out"; |
79
|
5
|
die "Unable to fetch Git repository '$dir' specified via $dir_variable (see log for details)" unless $return_code == 0; |
80
|
5
|
die "Could not find '$branch' in complete history in cloned Git repository '$dir'" if grep /remote: Total 0/, @out; |
81
|
5
|
} |
82
|
5
|
qx{git -C $local_path checkout $branch}; |
83
|
5
|
die "Unable to checkout branch '$branch' in cloned Git repository '$dir'" unless $? == 0; |
84
|
|
} |
85
|
1
|
else { |
86
|
1
|
$handle_output->(); |
87
|
|
} |
88
|
|
} |
89
|
1
|
else { |
90
|
|
bmwqemu::diag "Skipping to clone '$clone_url'; $local_path already exists"; |
91
|
|
} |
92
|
|
return $bmwqemu::vars{$dir_variable} = path($local_path)->to_abs->to_string; |
93
|
1
|
} |
94
|
|
|
95
|
2
|
=head2 checkout_git_refspec |
96
|
|
|
97
|
|
checkout_git_refspec($dir, $refspec_variable); |
98
|
|
|
99
|
|
Takes a git working copy directory path and checks out a git refspec specified |
100
|
|
in a git hash test parameter if possible. Returns the determined git hash in |
101
|
|
any case, also if C<$refspec> was not specified or is not defined. |
102
|
|
|
103
|
|
Example: |
104
|
|
|
105
|
|
checkout_git_refspec('/path/to/casedir', 'TEST_GIT_REFSPEC'); |
106
|
|
|
107
|
|
=cut |
108
|
|
return undef unless defined $dir; |
109
|
|
if (my $refspec = $bmwqemu::vars{$refspec_variable}) { |
110
|
|
bmwqemu::diag "Checking out local git refspec '$refspec' in '$dir'"; |
111
|
43
|
qx{env git -C $dir checkout -q $refspec}; |
|
43
|
|
|
43
|
|
|
43
|
|
112
|
43
|
die "Failed to checkout '$refspec' in '$dir'\n" unless $? == 0; |
113
|
43
|
} |
114
|
1
|
calculate_git_hash($dir); |
115
|
1
|
} |
116
|
1
|
|
117
|
|
=head2 handle_generated_assets |
118
|
42
|
|
119
|
|
Handles the assets generated by the test depending on status and test |
120
|
|
configuration variables. |
121
|
|
|
122
|
|
=cut |
123
|
|
|
124
|
|
my $return_code = 0; |
125
|
|
# mark hard disks for upload if test finished |
126
|
|
return unless $bmwqemu::vars{BACKEND} =~ m/^(qemu|generalhw)$/; |
127
|
|
my @toextract; |
128
|
4
|
my $nd = $bmwqemu::vars{NUMDISKS}; |
|
4
|
|
|
4
|
|
|
4
|
|
129
|
4
|
if ($command_handler->test_completed) { |
130
|
|
for my $i (1 .. $nd) { |
131
|
4
|
my $dir = 'assets_private'; |
132
|
3
|
my $name = $bmwqemu::vars{"STORE_HDD_$i"} || undef; |
133
|
3
|
unless ($name) { |
134
|
3
|
$name = $bmwqemu::vars{"PUBLISH_HDD_$i"} || undef; |
135
|
2
|
$dir = 'assets_public'; |
136
|
2
|
} |
137
|
2
|
next unless $name; |
138
|
2
|
push @toextract, _store_asset($i, $name, $dir); |
139
|
2
|
} |
140
|
2
|
if ($bmwqemu::vars{UEFI} && $bmwqemu::vars{PUBLISH_PFLASH_VARS}) { |
141
|
|
push(@toextract, {pflash_vars => 1, |
142
|
2
|
name => $bmwqemu::vars{PUBLISH_PFLASH_VARS}, |
143
|
0
|
dir => 'assets_public', |
144
|
|
format => 'qcow2'}); |
145
|
2
|
} |
146
|
|
if (@toextract && !$clean_shutdown) { |
147
|
|
bmwqemu::serialize_state(component => 'isotovideo', msg => 'unable to handle generated assets: machine not shut down when uploading disks', error => 1); |
148
|
0
|
return 1; |
149
|
|
} |
150
|
|
} |
151
|
2
|
for my $i (1 .. $nd) { |
152
|
0
|
my $name = $bmwqemu::vars{"FORCE_PUBLISH_HDD_$i"} || next; |
153
|
0
|
bmwqemu::diag "Requested to force the publication of '$name'"; |
154
|
|
push @toextract, _store_asset($i, $name, 'assets_public'); |
155
|
|
} |
156
|
3
|
for my $asset (@toextract) { |
157
|
3
|
local $@; |
158
|
2
|
eval { $bmwqemu::backend->extract_assets($asset); }; |
159
|
2
|
if ($@) { |
160
|
|
bmwqemu::serialize_state(component => 'backend', msg => "unable to extract assets: $@", error => 1); |
161
|
3
|
$return_code = 1; |
162
|
2
|
} |
163
|
2
|
} |
|
2
|
|
164
|
2
|
return $return_code; |
165
|
0
|
} |
166
|
0
|
|
167
|
|
=head2 load_test_schedule |
168
|
|
|
169
|
3
|
Loads the test schedule (main.pm) or particular test modules if the `SCHEDULE` variable is |
170
|
|
present. |
171
|
|
|
172
|
|
=cut |
173
|
|
|
174
|
|
# add lib of the test distributions - but only for main.pm not to pollute |
175
|
|
# further dependencies (the tests get it through autotest) |
176
|
|
my @oldINC = @INC; |
177
|
|
unshift @INC, $bmwqemu::vars{CASEDIR} . '/lib'; |
178
|
|
if ($bmwqemu::vars{SCHEDULE}) { |
179
|
27
|
unshift @INC, '.' unless path($bmwqemu::vars{CASEDIR})->is_abs; |
|
27
|
|
180
|
|
bmwqemu::fctinfo 'Enforced test schedule by \'SCHEDULE\' variable in action'; |
181
|
|
$bmwqemu::vars{INCLUDE_MODULES} = undef; |
182
|
27
|
autotest::loadtest($_ =~ qr/\./ ? $_ : $_ . '.pm') foreach split(/[, ]+/, $bmwqemu::vars{SCHEDULE}); |
183
|
27
|
$bmwqemu::vars{INCLUDE_MODULES} = 'none'; |
184
|
27
|
} |
185
|
17
|
my $productdir = $bmwqemu::vars{PRODUCTDIR}; |
186
|
17
|
my $main_path = path($productdir, 'main.pm'); |
187
|
17
|
try { |
188
|
17
|
if (-e $main_path) { |
189
|
16
|
unshift @INC, '.'; |
190
|
|
require $main_path; |
191
|
26
|
} |
192
|
26
|
elsif (!path($productdir)->is_abs && -e path($bmwqemu::vars{CASEDIR}, $main_path)) { |
193
|
|
require(path($bmwqemu::vars{CASEDIR}, $main_path)->to_string); |
194
|
26
|
} |
195
|
20
|
elsif ($productdir && !-e $productdir) { |
196
|
20
|
die "PRODUCTDIR '$productdir' invalid, could not be found"; |
197
|
|
} |
198
|
|
elsif (!$bmwqemu::vars{SCHEDULE}) { |
199
|
1
|
die "'SCHEDULE' not set and $main_path not found, need one of both"; |
200
|
|
} |
201
|
|
} |
202
|
1
|
catch { |
203
|
|
# record that the exception is caused by the tests themselves before letting it pass |
204
|
|
my $error_message = $_; |
205
|
1
|
bmwqemu::serialize_state(component => 'tests', msg => 'unable to load main.pm, check the log for the cause (e.g. syntax error)'); |
206
|
|
die "$error_message\n"; |
207
|
|
}; |
208
|
|
@INC = @oldINC; |
209
|
|
|
210
|
2
|
if ($bmwqemu::vars{_EXIT_AFTER_SCHEDULE}) { |
211
|
2
|
bmwqemu::fctinfo 'Early exit has been requested with _EXIT_AFTER_SCHEDULE. Only evaluating test schedule.'; |
212
|
2
|
exit 0; |
213
|
26
|
} |
214
|
24
|
} |
215
|
|
|
216
|
24
|
$name =~ /\.([[:alnum:]]+)$/; |
217
|
5
|
my $format = $1; |
218
|
5
|
return {hdd_num => $index, name => $name, dir => $dir, format => $format}; |
219
|
|
} |
220
|
|
|
221
|
|
1; |