File Coverage

OpenQA/Isotovideo/Utils.pm
Criterion Covered Total %
statement 149 155 96.1
total 149 155 96.1


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;