File Coverage

bmwqemu.pm
Criterion Covered Total %
statement 272 272 100.0
total 272 272 100.0


line stmt code
1   # Copyright 2009-2013 Bernhard M. Wiedemann
2   # Copyright 2012-2021 SUSE LLC
3   # SPDX-License-Identifier: GPL-2.0-or-later
4    
5    
6   use Mojo::Base -strict, -signatures;
7 94 use autodie ':all';
  94  
  94  
8 94 use Fcntl ':flock';
  94  
  94  
9 94 use Time::HiRes qw(sleep);
  94  
  94  
10 94 use IO::Socket;
  94  
  94  
11 94 use Carp;
  94  
  94  
12 94 use Mojo::JSON qw(encode_json);
  94  
  94  
13 94 use Cpanel::JSON::XS ();
  94  
  94  
14 94 use File::Path 'remove_tree';
  94  
  94  
15 94 use Data::Dumper;
  94  
  94  
16 94 use Mojo::Log;
  94  
  94  
17 94 use Mojo::File qw(path);
  94  
  94  
18 94 use Term::ANSIColor;
  94  
  94  
19 94  
  94  
  94  
20   use Exporter 'import';
21 94  
  94  
  94  
22   our $VERSION;
23   our @EXPORT_OK = qw(diag fctres fctinfo fctwarn modstate save_vars);
24    
25   require IPC::System::Simple;
26   use log;
27 94  
  94  
  94  
28   sub mydie;
29    
30   $| = 1;
31    
32    
33   our $default_timeout = 30; # assert timeout, 0 is a valid timeout
34   our $openqa_default_share = '/var/lib/openqa/share';
35    
36   my @ocrrect;
37    
38   our $screenshotpath = "qemuscreenshot";
39    
40   # global vars
41    
42   # Known locations of OVMF (UEFI) firmware: first is openSUSE, second is
43   # the kraxel.org nightly packages, third is Fedora's edk2-ovmf package,
44   # fourth is Debian's ovmf package.
45   our @ovmf_locations = (
46   '/usr/share/qemu/ovmf-x86_64-ms-code.bin', '/usr/share/edk2.git/ovmf-x64/OVMF_CODE-pure-efi.fd',
47   '/usr/share/edk2/ovmf/OVMF_CODE.fd', '/usr/share/OVMF/OVMF_CODE.fd'
48   );
49    
50   our %vars;
51   tie %vars, 'bmwqemu::tiedvars', %vars;
52    
53    
54 192 # deprecated functions, moved to log module
  192  
  192  
55   {
56   no warnings 'once';
57   *log_format_callback = \&log::log_format_callback;
58 94 *diag = \&log::diag;
  94  
  94  
59   *fctres = \&log::fctres;
60   *fctinfo = \&log::fctinfo;
61   *fctwarn = \&log::fctwarn;
62   *modstate = \&log::modstate;
63   *logger = \&log::logger;
64   *init_logger = \&log::init_logger;
65   }
66    
67   use constant STATE_FILE => 'base_state.json';
68    
69 94 # Write a JSON representation of the process termination to disk
  94  
  94  
70   bmwqemu::fctwarn($state{msg}) if delete $state{error};
71   bmwqemu::diag($state{msg}) if delete $state{log};
72 14 return undef if -e STATE_FILE;
  14  
  14  
73 14 eval { path(STATE_FILE)->spurt(encode_json(\%state)) };
74 14 bmwqemu::diag("Unable to serialize fatal error: $@") if $@;
75 14 }
76 8  
  8  
77 8 my $fn = "vars.json";
78   my $ret = {};
79   local $/;
80 33 my $fh;
  33  
81 33 eval { open($fh, '<', $fn) };
82 33 return 0 if $@;
83 33 eval { $ret = Cpanel::JSON::XS->new->relaxed->decode(<$fh>); };
84 33 die "parse error in vars.json:\n$@" if $@;
85 33 close($fh);
  33  
86 33 %vars = %{$ret};
87 22 return;
  22  
88 22 }
89 22  
90 22 my $fn = "vars.json";
  22  
91 22 unlink "vars.json" if -e "vars.json";
92   open(my $fd, ">", $fn);
93   flock($fd, LOCK_EX) or die "cannot lock vars.json: $!\n";
94 85 truncate($fd, 0) or die "cannot truncate vars.json: $!\n";
  85  
  85  
95 85  
96 85 my $write_vars = \%vars;
97 85 if ($args{no_secret}) {
98 85 $write_vars = {};
99 85 $write_vars->{$_} = $vars{$_} for (grep !/(^_SECRET_|_PASSWORD)/, keys(%vars));
100   }
101 85  
102 85 # make sure the JSON is sorted
103 23 my $json = Cpanel::JSON::XS->new->pretty->canonical;
104 23 print $fd $json->encode($write_vars);
105   close($fd);
106   return;
107   }
108 85  
109 85 our $gocrbin = "/usr/bin/gocr";
110 85  
111 85 # set from isotovideo during initialization
112   our $scriptdir;
113    
114   load_vars();
115    
116   $vars{BACKEND} ||= "qemu";
117    
118   # remove directories for asset upload
119 29 remove_tree("assets_public");
  29  
120 29 remove_tree("assets_private");
121    
122 29 remove_tree(result_dir);
123   mkdir result_dir;
124   mkdir join('/', result_dir, 'ulogs');
125 29  
126 29 log::init_logger;
127   }
128 29  
129 29 return 0 unless my $nd = $vars{NUMDISKS};
130 29 my @hdds = map { $vars{"HDD_$_"} } 1 .. $nd;
131   for my $i (1 .. $nd) {
132 29 for my $type (qw(STORE PUBLISH FORCE_PUBLISH)) {
133   my $name = $type . "_HDD_$i";
134   next unless my $out = $vars{$name};
135 27 die "HDD_$i also specified in $name. This is not supported" if grep { $_ && $_ eq $out } @hdds;
  27  
136 27 }
137 2 }
  2  
138 2 return 1;
139 2 }
140 5  
141 5 # defaults
142 2 $vars{QEMUPORT} ||= 15222;
  2  
143   $vars{VNC} ||= 90;
144   # openQA already sets a random string we can reuse
145 1 $vars{JOBTOKEN} ||= random_string(10);
146    
147   if ($gocrbin && !-x $gocrbin) {
148 26 $gocrbin = undef;
  26  
149   }
150 26  
151 26 die "CASEDIR variable not set, unknown test case directory" if !defined $vars{CASEDIR};
152   die "No scripts in CASEDIR '$vars{CASEDIR}'\n" unless -e $vars{CASEDIR};
153 26 _check_publish_vars();
154   save_vars();
155 26 }
156 26  
157   ## some var checks end
158    
159 26 # global vars end
160 25  
161 25 # local vars
162 25  
163   our $backend;
164    
165   # local vars end
166    
167   # util and helper functions
168    
169   require autotest;
170   no warnings 'once';
171   return $autotest::current_test;
172   }
173    
174   return unless current_test;
175   return unless current_test->{script};
176   my @out;
177 272 my $casedir = $vars{CASEDIR} // '';
  272  
178 272 for (my $i = 10; $i > 0; $i--) {
179 94 my ($package, $filename, $line, $subroutine) = caller($i);
  94  
  94  
180 272 next unless $filename && $filename =~ /\Q$casedir/;
181   $filename =~ s@$casedir/?@@;
182   push @out, "$filename:$line called $subroutine";
183 251 }
  251  
184 251 log::logger->debug(join(' -> ', @out));
185 21 return;
186 1 }
187 1  
188 1 # pretty print like Data::Dumper but without the "VAR1 = " prefix
189 10 # FTR, I actually hate Data::Dumper.
190 10 my $value_with_trailing_newline = Data::Dumper->new(\@args)->Terse(1)->Useqq(1)->Dump();
191 10 chomp($value_with_trailing_newline);
192 10 return $value_with_trailing_newline;
193   }
194 1  
195 1 # Use special argument `-masked` to hide the given value in log output.
196   # It can be specified multiple times and or the value can be a ARRAY_REF or
197   # scalar.
198   my $fname = (caller(1))[3];
199 925 update_line_number();
  925  
  925  
200    
201 925 # extract -masked parameter out of argument list
202 925 my @masked;
203 925 my @effective_args;
204   while (@args) {
205   my $v = shift @args;
206   if (defined($v) && $v eq '-masked' && @args) {
207   my $mval = shift @args;
208   push @masked, ref($mval) eq 'ARRAY' ? @$mval : $mval;
209 249 } else {
  249  
  249  
210 249 push @effective_args, $v;
211 249 }
212   }
213    
214 249 my $params;
215   if (@effective_args == 1) {
216 249 $params = pp($effective_args[0]);
217 1812 }
218 1812 else {
219 9 # key/value pairs
220 9 my @result;
221   while (my ($key, $value) = splice(@effective_args, 0, 2)) {
222 1803 if ($key =~ tr/0-9a-zA-Z_//c) {
223   # only quote if needed
224   $key = pp($key);
225   }
226 249 push @result, join("=", $key, pp($value));
227 249 }
228 1 $params = join(", ", @result);
229   }
230    
231   foreach (@masked) {
232 248 my $mask = pp($_);
233 248 $mask =~ s/^"(.*)"$/$1/;
234 901 $params =~ s/\Q$mask\E/[masked]/g;
235   }
236 1  
237   log::logger->debug('<<< ' . $fname . "($params)");
238 901 return;
239   }
240 248  
241   # util and helper functions end
242    
243 249 # backend management
244 11  
245 11 return unless $backend;
246 11 my $ret = $backend->stop();
247   return $ret;
248   }
249 249  
250 249 log_call(cause_of_death => $cause_of_death);
251   croak "mydie";
252   }
253    
254   # runtime information gathering functions end
255    
256    
257 3 # store the obj as json into the given filename
  3  
258 3 open(my $fd, ">", "$fn.new");
259 3 my $json = Cpanel::JSON::XS->new->pretty->canonical->encode($result);
260 3 print $fd $json;
261   close($fd);
262   return rename("$fn.new", $fn);
263 9 }
  9  
  9  
264 9  
265 9 return $timeout * ($vars{TIMEOUT_SCALE} // 1);
266   }
267    
268   =head2 random_string
269    
270   random_string([$count]);
271    
272 1 Just a random string useful for pseudo security or temporary files.
  1  
  1  
  1  
273 1 =cut
274 1 $count //= 4;
275 1 my $string;
276 1 my @chars = ('a' .. 'z', 'A' .. 'Z');
277 1 $string .= $chars[rand @chars] for 1 .. $count;
278   return $string;
279   }
280 41  
  41  
  41  
281 41 # sleeping for one second should ensure that one more screenshot is taken
282    
283   use Tie::Hash;
284   use base qw/ Tie::StdHash /; # no:style prevent style warning regarding use of Mojo::Base and base in this file
285   use Carp ();
286    
287   my $self = bless {
288   data => {%args},
289   }, $class;
290 555 }
  555  
  555  
291 555  
292 555 warn Carp::longmess "Settings key '$key' is invalid" unless $key =~ m/^(?:[A-Z0-9_]+)\z/;
293 555 $self->{data}->{$key} = $val;
294 555 }
295 555  
296   my $data = $self->{data};
297   my @k = keys %$data; # reset
298   my $next = each %$data;
299 1 }
  1  
  1  
300    
301   my $data = $self->{data};
302 94 my $next = each %$data;
  94  
  94  
303 94 }
  94  
  94  
304 94  
  94  
  94  
305   my $val = $self->{data}->{$key};
306 94 }
  94  
  94  
  94  
307 94  
308    
309    
310    
311    
312 868 1;
  868  
  868  
  868  
  868