-
Notifications
You must be signed in to change notification settings - Fork 276
/
utils.pm
1293 lines (1122 loc) · 56 KB
/
utils.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# SUSE's openQA tests
#
# Copyright 2020-2023 SUSE LLC
# SPDX-License-Identifier: GPL-2.0-or-later
# Summary: virtualization test utilities.
# Maintainer: Julie CAO <jcao@suse.com>, qe-virt@suse.de
package virt_autotest::utils;
use base Exporter;
use Exporter;
use strict;
use warnings;
use utils;
use upload_system_log 'upload_supportconfig_log';
use version_utils;
use testapi;
use DateTime;
use NetAddr::IP;
use Net::IP qw(:PROC);
use File::Basename;
use LWP::Simple 'head';
use Utils::Architectures;
use IO::Socket::INET;
use Carp;
our @EXPORT = qw(is_vmware_virtualization is_hyperv_virtualization is_fv_guest is_pv_guest is_sev_es_guest guest_is_sle is_guest_ballooned is_xen_host is_kvm_host
is_monolithic_libvirtd turn_on_libvirt_debugging_log restart_libvirtd check_libvirtd restart_modular_libvirt_daemons check_modular_libvirt_daemons
reset_log_cursor check_failures_in_journal check_host_health check_guest_health print_cmd_output_to_file collect_virt_system_logs setup_rsyslog_host download_script download_script_and_execute upload_virt_logs enable_nm_debug upload_nm_debug_log
ssh_setup setup_common_ssh_config add_alias_in_ssh_config install_default_packages parse_subnet_address_ipv4 backup_file manage_system_service check_port_state is_registered_system do_system_registration check_system_registration subscribe_extensions_and_modules check_activate_network_interface wait_for_host_reboot
create_guest import_guest ssh_copy_id add_guest_to_hosts ensure_default_net_is_active ensure_guest_started remove_additional_disks remove_additional_nic start_guests is_guest_online ensure_online wait_guest_online restore_downloaded_guests save_original_guest_xmls restore_original_guests save_guests_xml_for_change restore_xml_changed_guests shutdown_guests wait_guests_shutdown remove_vm recreate_guests download_vm_import_disks get_guest_regcode
);
my %log_cursors;
# helper function: Trim string
sub trim {
my $text = shift;
$text =~ s/^\s+|\s+$//g;
return $text;
}
#return 1 if test is expected to run on XEN hypervisor
sub is_xen_host {
return get_var("XEN") || check_var("SYSTEM_ROLE", "xen") || check_var("HOST_HYPERVISOR", "xen") || check_var("REGRESSION", "xen-hypervisor");
}
# Usage: check_modular_libvirt_daemons([daemon1_name daemon2_name ...]). For example:
# to specify daemons which will be checked: check_modular_libvirt_daemons(qemu storage ...)
# to check all required modular daemons without any daemons passed
sub check_modular_libvirt_daemons {
my @daemons = @_;
if (!@daemons) {
@daemons = qw(network nodedev nwfilter secret storage lock);
# For details, please refer to poo#137096
(is_xen_host) ? push @daemons, 'xen' : push @daemons, ('qemu', 'log');
}
foreach my $daemon (@daemons) {
systemctl("status virt${daemon}d.service");
if (($daemon eq 'lock') || ($daemon eq 'log')) {
systemctl("status virt${daemon}d\{,-admin\}.socket");
} else {
systemctl("status virt${daemon}d\{,-ro,-admin\}.socket");
}
}
save_screenshot;
record_info("Modular libvirt daemons checked, all active for", join(' ', @daemons));
}
# Usage: restart_modular_libvirt_daemons([daemon1_name daemon2_name ...]). For example:
# to specify daemons which will be restarted: restart_modular_libvirt_daemons(virtqemud virtstoraged ...)
# to restart all modular daemons without any daemons passed
sub restart_modular_libvirt_daemons {
my @daemons = @_;
if (!@daemons) {
@daemons = qw(network nodedev nwfilter secret storage lock);
# For details, please refer to poo#137096
(is_xen_host) ? push @daemons, 'xen' : push @daemons, ('qemu', 'log');
}
if (is_alp) {
record_soft_failure("Restarting modular libvirt daemons has not been implemented in ALP. See poo#129086");
} else {
# Restart the sockets first
foreach my $daemon (@daemons) {
if (($daemon eq 'lock') || ($daemon eq 'log')) {
systemctl("restart virt${daemon}d\{,-admin\}.socket");
} else {
systemctl("restart virt${daemon}d\{,-ro,-admin\}.socket");
}
}
# Introduce idle time here (e.g., sleep 5) if necessary
sleep 5;
# Restart the services after a brief idle time
foreach my $daemon (@daemons) {
systemctl("restart virt${daemon}d.service");
}
}
save_screenshot;
record_info("Modular Libvirt daemons restarted, all active for", join(' ', @daemons));
}
#return 1 if it is a VMware test judging by REGRESSION variable
sub is_vmware_virtualization {
return get_var("REGRESSION", '') =~ /vmware/;
}
#return 1 if it is a Hyper-V test judging by REGRESSION variable
sub is_hyperv_virtualization {
return get_var("REGRESSION", '') =~ /hyperv/;
}
#return 1 if it is a fv guest judging by name
#feel free to extend to support more cases
sub is_fv_guest {
my $guest = shift;
return $guest =~ /\bfv\b/ || $guest =~ /hvm/i;
}
#return 1 if it is a pv guest judging by name
#feel free to extend to support more cases
sub is_pv_guest {
my $guest = shift;
return $guest =~ /pv/i;
}
#Check if guest is SLE with optional filter for:
#Version: <=12-sp3 =12-sp1 >11-sp1 >=15 15+ (>=15 and 15+ are equivalent)
#usage: guest_is_sle($guest_name, '<=12-sp2')
sub guest_is_sle {
my $guest_name = lc shift;
my $query = shift;
return 0 unless $guest_name =~ /sle/;
return 1 unless $query;
# Version check
$guest_name =~ /sles-*(\d{2})(?:-*sp(\d))?/;
my $version = $2 eq '' ? "$1-sp0" : "$1-sp$2";
return check_version($query, $version, qr/\d{2}(?:-sp\d)?/);
}
#return 1 if max_mem > memory in vm configuration file in libvirt
sub is_guest_ballooned {
my $guest = shift;
my $mem = "";
my $cur_mem = "";
$mem = script_output "virsh dumpxml $guest | xmlstarlet sel -t -v //memory";
$cur_mem = script_output "virsh dumpxml $guest | xmlstarlet sel -t -v //currentMemory";
return $mem > $cur_mem;
}
#return 1 if test is expected to run on KVM hypervisor
sub is_kvm_host {
return check_var("SYSTEM_ROLE", "kvm") || check_var("HOST_HYPERVISOR", "kvm") || check_var("REGRESSION", "qemu-hypervisor");
}
#retrun 1 if libvirt 9.0- is running which monolithic libvirtd is the default service
sub is_monolithic_libvirtd {
record_info('WARNING', 'Libvirt package is not installed', result => 'fail') if (script_run('rpm -q libvirt-libs'));
unless (is_alp) {
return 1 if script_run('systemctl is-enabled libvirtd.service') == 0;
}
return 0;
}
# Restart libvirt daemon
sub restart_libvirtd {
if (is_sle('<12')) {
assert_script_run('rclibvirtd restart', 180);
}
elsif (is_alp) {
my $_libvirtd_pid = script_output(q@ps -ef |grep [l]ibvirtd | gawk '{print $2;}'@);
my $_libvirtd_cmd = script_output("ps -o command $_libvirtd_pid | tail -1");
assert_script_run("kill -9 $_libvirtd_pid");
assert_script_run("$_libvirtd_cmd");
}
elsif (is_monolithic_libvirtd) {
systemctl("restart libvirtd", timeout => 180);
} else {
restart_modular_libvirt_daemons;
}
save_screenshot;
record_info("Libvirtd Daemon has been restarted!");
}
# Check libvirt daemon
sub check_libvirtd {
is_monolithic_libvirtd ? systemctl("status libvirtd") : check_modular_libvirt_daemons;
record_info("Libvirtd Daemon has been checked!");
}
# For legacy libvird, set debug level logging for libvirtd services
# For modular libvirt, do the same settings to /etc/libvirt/virt{qemu,xen,driver}d.conf.
# virt{qemu,xen}d daemons provide the most important libvirt log(sufficient for most issues).
# virt{driver}.d daemons is only required by specific issues, eg virtual network failures may need virtnetworkd log.
# But our automation is better to set them to collect more logs as we could as possible.
# Developer asked to use different log file as log_output per daemon.
sub turn_on_libvirt_debugging_log {
my @libvirt_daemons = is_monolithic_libvirtd ? "libvirtd" : qw(virtqemud virtstoraged virtnetworkd virtnodedevd virtsecretd virtnwfilterd virtlockd);
# For details, please refer to poo#137096
push @libvirt_daemons, 'virtlogd' if is_kvm_host;
#turn on debug and log filter for libvirt services
#disable log_level = 1 'debug' as it generage large output
#the size of libvirtd with debug level and without any filter on sles15sp3 xen is over 100G,
#which consumes all the disk space. Now get comfirmation from virt developers,
#log filter is set to store component logs with different levels.
foreach my $daemon (@libvirt_daemons) {
my $conf_file = "/etc/libvirt/$daemon.conf";
if (script_run("ls $conf_file") == 0) {
script_run "sed -i 's/^[ ]*log_level *=/#&/' $conf_file";
script_run "sed -i '/^[# ]*log_outputs *=/{h;s%^[# ]*log_outputs *=.*[0-9].*\$%log_outputs = \"1:file:/var/log/libvirt/$daemon.log\"%};\${x;/^\$/{s%%log_outputs = \"1:file:/var/log/libvirt/$daemon.log\"%;H};x}' $conf_file";
script_run "sed -i '/^[# ]*log_filters *=/{h;s%^[# ]*log_filters *=.*[0-9].*\$%log_filters = \"1:qemu 1:libvirt 4:object 4:json 4:event 3:util 1:util.pci\"%};\${x;/^\$/{s%%log_filters = \"1:qemu 1:libvirt 4:object 4:json 4:event 3:util 1:util.pci\"%;H};x}' $conf_file";
}
}
script_run "grep -e 'log_level.*=' -e 'log_outputs.*=' -e 'log_filters.*=' /etc/libvirt/*d.conf";
save_screenshot;
restart_libvirtd;
}
# Reset journalctl cursor used by check_failures_in_journal() to skip already
# reported errors. The next health check will rescan all messages since boot.
# reset_log_cursor($machine) will reset cursor only for given machine
# reset_log_cursor() will reset cursors for all machines
sub reset_log_cursor {
my $machine = shift;
if (defined($machine)) {
delete $log_cursors{$machine};
}
else {
%log_cursors = ();
}
}
# Grep keywords from journals and report warnings, support x86_64 only
# Usage: check_failures_in_journal([machine], [no_cursor => 0]);
# [machine]: an IP or QUDN of ssh accesible machine. "localhost" ie. the SUT itself, by default.
# [no_cursor => 0]: value '0' means grep keywords from incremenal journal output only,
# ie. Start searching from the place you previously searched.
# value '1' means searching in the entire journal output(also including previous boots)
# keywords: only "Coredump" and "Call trace" have been included so far
# Work flow:
# - save journal output to a tmp file
# - get cursor from the saved file unless you'd like to search in the entire journals
# - grep each keywords in the saved file
# - if keywords are found, give warnings and upload the saved log
sub check_failures_in_journal {
return unless is_x86_64 and (is_sle or is_opensuse);
my ($machine, %args) = @_;
$machine //= 'localhost';
$args{no_cursor} //= 0;
# Save journal log to a tmp file
my $logfile = "/tmp/journalctl-$machine.log";
my $failures = "";
reset_log_cursor if $args{no_cursor} == 1;
my $cursor = $log_cursors{$machine};
my $cmd = "journalctl --show-cursor ";
$cmd .= "--cursor='$cursor'" if defined($cursor);
$cmd .= " > $logfile";
$cmd = "ssh -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no root\@$machine " . "\"$cmd\"" if $machine ne 'localhost';
if (script_run($cmd) != 0) {
$failures = "Fail to get journal logs from $machine";
record_info("Warning", "$failures when checking its health", result => 'softfail');
return $failures;
}
# Get the cursor of the journal log file
unless ($args{no_cursor}) {
$cmd = "grep -oe \'-- cursor: *[^ ]*\' $logfile | cut -d ' ' -f3";
$cmd = "ssh -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no root\@$machine " . "\"$cmd\"" if $machine ne 'localhost';
$log_cursors{$machine} = script_output("$cmd", type_command => 1);
}
# Search warnings from the journal log file
my @warnings = ('Started Process Core Dump', 'Call Trace');
foreach (@warnings) {
$cmd = "grep '$_' $logfile";
$cmd = "ssh -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no root\@$machine " . "\"$cmd\"" if $machine ne 'localhost';
$failures .= "\"$_\" in journals on $machine \n" if script_run("$cmd") == 0;
}
# In case of failures, print message and upload journal log
if ($failures) {
if (get_var('KNOWN_BUGS_FOUND_IN_JOURNAL')) {
record_soft_failure("Found failures: \n" . $failures . "There are known kernel bugs " . get_var('KNOWN_BUGS_FOUND_IN_JOURNAL') . ". Please look into journal files to determine if it is a known bug. If it is a new issue, please take action as described in poo#151361.");
record_info("Found failures in journal log", "Found failures: \n" . $failures . "There are known kernel bugs " . get_var('KNOWN_BUGS_FOUND_IN_JOURNAL') . ". Please look into journal files to determine if it is a known bug. If it is a new issue, please take action as described in poo#151361.", result => 'fail');
}
else {
record_soft_failure("Found new failures: " . $failures . " please take actions as described in poo#151361.\n");
record_info("Found failures in journal log", "Found new failures: " . $failures . " please take actions as described in poo#151361.\n", result => 'fail');
}
# ignore the attempt timing out with "timeout 20" which exits before
# the script_run internal timeout
script_run("timeout 20 rsync root\@$machine:$logfile $logfile") if $machine ne 'localhost';
upload_logs($logfile);
}
return $failures;
}
# Do some basic check to host to see if it is working well
# Support x86_64 only
# Return 'pass' and 'fail' if there are or are not failures.
# Welcome everybody to extend this function
sub check_host_health {
return unless is_x86_64 and (is_sle or is_opensuse);
my $failures = caller 0 eq 'validate_system_health' ? check_failures_in_journal('localhost', no_cursor => 1) : check_failures_in_journal();
unless ($failures) {
record_info("Healthy host!");
return 'pass';
}
record_info("Unhealthy host", $failures, result => 'fail');
return 'fail';
}
# Do some basic check to specified guest tto see if it is working well
# Return 'pass' and 'fail' if there are or are not failures.
# Support x86_64 only
# Welcome everybody to extend this function
sub check_guest_health {
my $vm = shift;
return unless is_x86_64 and ($vm =~ /sle|alp/i);
#check if guest is still alive
my $vmstate = "nok";
my $failures = "";
if (script_run("virsh list --all | grep \"$vm \"") == 0) {
$vmstate = "ok" if (script_run("virsh domstate $vm | grep running") == 0);
}
elsif (is_xen_host and script_run("xl list $vm") == 0) {
script_retry("xl list $vm | grep \"\\-b\\-\\-\\-\\-\"", delay => 10, retry => 1, die => 0) for (0 .. 3);
$vmstate = "ok" if script_run("xl list $vm | grep \"\\-b\\-\\-\\-\\-\"");
}
if ($vmstate eq "ok") {
$failures = caller 0 eq 'validate_system_health' ? check_failures_in_journal($vm, no_cursor => 1) : check_failures_in_journal($vm);
return 'fail' if $failures;
record_info("Healthy guest!", "$vm looks good so far!");
}
else {
record_info("Skip check_failures_in_journal for $vm", "$vm is not in desired state judged by either virsh or xl tool stack", result => 'softfail');
}
return 'pass';
}
#ammend the output of the command to an existing log file
#$machine=<guest_ip> to pass guest name or an remote IP if running command in a remote machine
#default $machine is the current SUT, ie. the host.
#make sure '$file' is present in current SUT(host), it wastes time to check the file in each call.
#only support simple bash command so far, eg. '|' is not supported in $cmd.
sub print_cmd_output_to_file {
my ($cmd, $file, $machine) = @_;
$cmd = "ssh -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no root\@$machine \"" . $cmd . "\"" unless (!$machine or $machine eq 'localhost');
script_run "echo -e \"\n# $cmd\" >> $file";
script_run "$cmd >> $file";
}
sub download_script_and_execute {
my ($script_name, %args) = @_;
$args{output_file} //= "$args{script_name}.log";
$args{machine} //= 'localhost';
$args{proceed_on_failure} //= 0;
download_script($script_name, script_url => $args{script_url}, machine => $args{machine}, proceed_on_failure => $args{proceed_on_failure});
my $cmd = "~/$script_name";
$cmd = "ssh root\@$args{machine} " . "\"$cmd\"" if ($args{machine} ne 'localhost');
script_run("$cmd >> $args{output_file} 2>&1");
}
sub download_script {
my ($script_name, %args) = @_;
my $script_url = $args{script_url} // data_url("virt_autotest/$script_name");
my $machine = $args{machine} // 'localhost';
$args{proceed_on_failure} //= 0;
unless (head($script_url)) {
if ($args{proceed_on_failure}) {
record_info("URL is not accessible", "$script_url", result => 'fail');
return;
}
else {
die "$script_url is not accessible!";
}
}
my $cmd = "curl -o ~/$script_name $script_url";
$cmd = "ssh root\@$machine " . "\"$cmd\"" if ($machine ne 'localhost');
unless (script_retry($cmd, timeout => 900, retry => 2, die => 0) == 0) {
record_info("Failed to download", "Fail to download $script_url on $machine, however it is accessible from worker instance!", result => 'fail');
unless ($machine eq 'localhost') {
# Have to output debug info at here because no logs will be uploaded if there are connection problems
if (script_run("ssh root\@$machine 'hostname'") == 0) {
$script_url =~ /^https?:\/\/([\w\.]+)(:\d+)?\/.*/;
script_run("ssh root\@$machine 'ping $1'");
script_run("ssh root\@$machine 'traceroute $1'");
script_run("ssh root\@$machine 'ping -c3 openqa.suse.de'");
script_run("ssh root\@$machine 'nslookup " . get_var('WORKER_HOSTNAME', 'openqa.suse.de') . "'");
script_run("ssh root\@$machine 'cat /etc/resolv.conf'");
}
else {
record_info("machine is not ssh accessible", "$machine", result => 'fail');
}
}
$args{proceed_on_failure} ? return : die "Failed to download $script_url on $machine!";
}
$cmd = "chmod +x ~/$script_name";
$cmd = "ssh root\@$machine " . "\"$cmd\"" if ($machine ne 'localhost');
script_run($cmd);
}
sub ssh_setup {
my $default_ssh_key = shift;
$default_ssh_key //= (!(get_var('VIRT_AUTOTEST'))) ? "/root/.ssh/id_rsa" : "/var/testvirt.net/.ssh/id_rsa";
my $dt = DateTime->now;
my $comment = "openqa-" . $dt->mdy . "-" . $dt->hms('-') . get_var('NAME');
if (script_run("[[ -s $default_ssh_key ]]") != 0) {
my $default_ssh_key_dir = dirname($default_ssh_key);
script_run("mkdir -p $default_ssh_key_dir");
assert_script_run "ssh-keygen -t rsa -P '' -C '$comment' -f $default_ssh_key";
record_info("Created ssh rsa key in $default_ssh_key successfully.");
} else {
record_info("Skip ssh rsa key recreation in $default_ssh_key, which exists.");
}
assert_script_run("ls `dirname $default_ssh_key`");
save_screenshot;
}
sub ssh_copy_id {
my ($guest, %args) = @_;
my $username = $args{username} // 'root';
my $authorized_keys = $args{authorized_keys} // '.ssh/authorized_keys';
my $scp = $args{scp} // 0;
my $mode = is_sle('=11-sp4') ? '' : '-f';
my $default_ssh_key = $args{default_ssh_key};
$default_ssh_key //= (!(get_var('VIRT_AUTOTEST'))) ? "/root/.ssh/id_rsa.pub" : "/var/testvirt.net/.ssh/id_rsa.pub";
script_retry "nmap $guest -PN -p ssh | grep open", delay => 15, retry => 12;
assert_script_run "ssh-keyscan $guest >> ~/.ssh/known_hosts";
if (script_run("ssh -o PreferredAuthentications=publickey -o ControlMaster=no $username\@$guest hostname") != 0) {
# Our client key is not authorized, we have to type password with evry command
my $options = "-o PreferredAuthentications=password,keyboard-interactive -o ControlMaster=no";
unless ($scp == 1) {
exec_and_insert_password("ssh-copy-id $options $mode -i $default_ssh_key $username\@$guest");
} else {
exec_and_insert_password("ssh $options $username\@$guest 'mkdir .ssh' || true");
exec_and_insert_password("scp $options $default_ssh_key $username\@$guest:'$authorized_keys'");
if (script_run("nmap $guest -PN -p ssh -sV | grep Windows") == 0) {
exec_and_insert_password("ssh $options $username\@$guest 'icacls $authorized_keys /remove \"NT AUTHORITY\\Authenticated Users\"'");
exec_and_insert_password("ssh $options $username\@$guest 'icacls $authorized_keys /inheritance:r'");
} else {
exec_and_insert_password("ssh $options $username\@$guest 'chmod 0700 ~/.ssh/'");
exec_and_insert_password("ssh $options $username\@$guest 'chmod 0644 ~/.ssh/authorized_keys'");
}
}
assert_script_run "ssh -o PreferredAuthentications=publickey -o ControlMaster=no $username\@$guest hostname";
}
}
sub create_guest {
my ($guest, $method) = @_;
my $v_type = $guest->{name} =~ /HVM/ ? "-v" : "";
my $name = $guest->{name};
my $location = $guest->{location};
my $autoyast = $guest->{autoyast};
my $macaddress = $guest->{macaddress};
my $on_reboot = $guest->{on_reboot} // "restart"; # configurable on_reboot policy
my $extra_params = $guest->{extra_params} // ""; # extra-parameters
my $memory = $guest->{memory} // "2048";
# poo#11786, set maxmemory bigger
my $maxmemory = $guest->{maxmemory} // $memory + 1536; # use by default just a bit more, so that we don't waste memory but still use the functionality
my $vcpus = $guest->{vcpus} // "2";
my $maxvcpus = $guest->{maxvcpus} // $vcpus + 1; # same as for memory, test functionality but don't waste resources
my $extra_args = get_var("VIRTINSTALL_EXTRA_ARGS", "") . " " . get_var("VIRTINSTALL_EXTRA_ARGS_" . uc($name), "");
$extra_args = trim($extra_args);
if ($method eq 'virt-install') {
send_key 'ret'; # Make some visual separator
# Run unattended installation for selected guest
my ($autoyastURL, $diskformat, $virtinstall);
$autoyastURL = $autoyast;
$diskformat = get_var("VIRT_QEMU_DISK_FORMAT") // "qcow2";
$extra_args = "autoyast=$autoyastURL $extra_args";
$extra_args = trim($extra_args);
$virtinstall = "virt-install $v_type $guest->{osinfo} --name $name --vcpus=$vcpus,maxvcpus=$maxvcpus --memory=$memory,maxmemory=$maxmemory --vnc";
$virtinstall .= " --disk path=/var/lib/libvirt/images/$name.$diskformat,size=20,format=$diskformat --noautoconsole";
$virtinstall .= " --network bridge=br0 --autostart --location=$location --wait -1";
$virtinstall .= " --events on_reboot=$on_reboot" unless ($on_reboot eq '');
$virtinstall .= " --extra-args '$extra_args'" unless ($extra_args eq '');
record_info("$name", "Creating $name guests:\n$virtinstall");
script_run "$virtinstall >> ~/virt-install_$name.txt 2>&1 & true"; # true required because & terminator is not allowed
# wait for initrd to ensure the installation is starting
script_retry("grep -B99 -A99 'initrd' ~/virt-install_$name.txt", delay => 15, retry => 12, die => 0);
} else {
die "unsupported create_guest method '$method'";
}
}
sub import_guest {
my ($guest, $method) = @_;
my $name = $guest->{name};
my $disk = $guest->{disk};
my $macaddress = $guest->{macaddress};
my $extra_params = $guest->{extra_params} // "";
my $memory = $guest->{memory} // "2048";
my $maxmemory = $guest->{maxmemory} // $memory + 256; # use by default just a bit more, so that we don't waste memory but still use the functionality
my $vcpus = $guest->{vcpus} // "2";
my $maxvcpus = $guest->{maxvcpus} // $vcpus + 1; # same as for memory, test functionality but don't waste resources
my $network_model = $guest->{network_model} // "";
if ($method eq 'virt-install' || $method eq '') {
record_info "$name", "Going to import $name guest";
send_key 'ret'; # Make some visual separator
my $network = "network=default,mac=$macaddress,";
$network .= ",model=$network_model" unless ($network_model eq "");
# Run unattended installation for selected guest
my $virtinstall = "virt-install $extra_params --name $name --vcpus=$vcpus,maxvcpus=$maxvcpus --memory=$memory,maxmemory=$maxmemory --cpu host";
$virtinstall .= " --graphics vnc --disk $disk --network $network --noautoconsole --autostart --import";
assert_script_run $virtinstall;
} else {
die "unsupported import_guest method '$method'";
}
}
sub install_default_packages {
# Install nmap, ip, dig
if (is_s390x()) {
# Use static call to avoid cyclical imports
virt_utils::lpar_cmd("zypper --non-interactive in nmap iputils bind-utils");
} else {
zypper_call '-t in nmap iputils bind-utils', exitcode => [0, 4, 102, 103, 106];
}
}
# ensure_online($guest) - Ensures the given guests is started and fixes some common network issues
sub ensure_online {
my ($guest, %args) = @_;
my $hypervisor = defined $args{HYPERVISOR} ? $args{HYPERVISOR} : (get_var('VIRT_AUTOTEST') ? "192.168.123.1" : "192.168.122.1");
my $dns_host = $args{DNS_TEST_HOST} // "www.suse.com";
my $skip_ssh = $args{skip_ssh} // 0;
my $skip_network = $args{skip_network} // 0;
my $skip_ping = $args{skip_ping} // 0;
my $ping_delay = $args{ping_delay} // 15;
my $ping_retry = $args{ping_retry} // 60;
my $use_virsh = $args{use_virsh} // 1;
# Ensure guest is running
# Only xen/kvm support to reboot guest at the moment
if ($use_virsh && (is_xen_host || is_kvm_host)) {
if (script_run("virsh list | grep '$guest'") != 0) {
assert_script_run("virsh start '$guest'");
wait_guest_online($guest);
}
}
unless ($skip_network == 1) {
# Check if we can ping guest
unless ($skip_ping == 1) {
die "$guest does not respond to ICMP" if (script_retry("ping -c 1 '$guest'", delay => $ping_delay, retry => $ping_retry) != 0);
}
unless ($skip_ssh == 1) {
# Wait for ssh to come up
die "$guest does not start ssh" if (script_retry("nmap $guest -PN -p ssh | grep open", delay => 30, retry => 12, timeout => 360) != 0);
die "$guest not ssh-reachable" if (script_run("ssh $guest uname") != 0);
# Ensure default route is set
if (script_run("ssh $guest ip r s | grep default") != 0) {
assert_script_run("ssh $guest ip r a default via $hypervisor");
}
# Check if we can ping hypervizor from the guest
unless ($skip_ping == 1) {
die "Pinging hypervisor failed for $guest" if (script_retry("ssh $guest ping -c 3 $hypervisor", delay => 1, retry => 10, timeout => 90) != 0);
}
# Check also if name resolution works - restart libvirtd if not
if (script_run("ssh $guest ping -c 3 -w 120 $dns_host", timeout => 180) != 0) {
# Note: TBD for modular libvirt. See poo#129086 for detail.
restart_libvirtd;
die "name resolution failed for $guest" if (script_retry("ssh $guest ping -c 3 -w 120 $dns_host", delay => 1, retry => 10, timeout => 180) != 0);
}
}
}
}
sub ensure_default_net_is_active {
if (script_run("virsh net-list --all | grep default | grep ' active'", 90) != 0) {
# Note: TBD for modular libvirt. See poo#129086 for detail.
restart_libvirtd;
if (script_run("virsh net-list --all | grep default | grep ' active'", 90) != 0) {
assert_script_run "virsh net-start default";
}
}
}
sub add_guest_to_hosts {
my ($hostname, $address) = @_;
assert_script_run "sed -i '/ $hostname /d' /etc/hosts";
assert_script_run "echo '$address $hostname # virtualization' >> /etc/hosts";
}
# Remove additional disks from the given guest. We remove all disks that match the given pattern or 'vd[b-z]' if no pattern is given
sub remove_additional_disks {
my $guest = $_[0];
my $pattern = $_[1] // "x?vd[b-z]";
return if ($guest == 0);
my $cmd = 'for i in `virsh domblklist ' . "'$guest'" . ' | grep ' . "'$pattern'" . ' | awk "{print $1}"`; do virsh detach-disk ' . "'$guest' " . '"$i"; done';
return script_run($cmd);
}
# Remove additional network interfaces from $guest. The NIC needs to be identified by it's mac address of mac address prefix (e.g. '00:16:3f:32')
# returns the status code of the remove command
sub remove_additional_nic {
my $guest = $_[0] // '';
my $mac_prefix = $_[1] // '';
return if ($guest == 0);
die "mac_prefix not defined" if ($mac_prefix == 0);
my $cmd = 'for i in `virsh domiflist ' . "'$guest'" . ' | grep ' . "'$mac_prefix'" . ' | awk "{print $5}"`; do virsh detach-interface ' . "'$guest'" . ' bridge --mac "$i"; done';
return script_run($cmd);
}
sub collect_virt_system_logs {
if (script_run("test -f /var/log/libvirt/*d.log") == 0) {
script_run('tar czvf /tmp/libvirt_daemons.tar.gz /var/log/libvirt/*d.log');
upload_asset("/tmp/libvirt_daemons.tar.gz");
}
else {
record_info "File /var/log/libvirt/*d.log does not exist.";
}
if (script_run("test -d /var/log/libvirt/libxl/") == 0) {
assert_script_run 'tar czvf /tmp/libxl.tar.gz /var/log/libvirt/libxl/';
upload_asset '/tmp/libxl.tar.gz';
} else {
record_info "Directory /var/log/libvirt/libxl/ does not exist.";
}
if (script_run("test -d /var/log/xen/") == 0) {
assert_script_run 'tar czvf /tmp/xen.tar.gz /var/log/xen/';
upload_asset '/tmp/xen.tar.gz';
} else {
record_info "Directory /var/log/xen/ does not exist.";
}
assert_script_run("journalctl -b > /tmp/journalctl-b.txt");
upload_logs("/tmp/journalctl-b.txt");
assert_script_run 'virsh list --all';
assert_script_run 'mkdir -p /tmp/dumpxml';
assert_script_run 'for guest in `virsh list --all --name`; do virsh dumpxml $guest > /tmp/dumpxml/$guest.xml; done';
assert_script_run 'tar czvf /tmp/dumpxml.tar.gz /tmp/dumpxml/';
upload_asset '/tmp/dumpxml.tar.gz';
upload_system_log::upload_supportconfig_log();
}
# is_guest_online($guest) check if the given guests is online by probing for an open ssh port
sub is_guest_online {
my $guest = shift;
return script_run("nmap $guest -PN -p ssh | grep open") == 0;
}
# wait_guest_online($guest, [$timeout]) waits until the given guests is online by probing for an open ssh port
# If [$state_check] is not zero, guest state checking will be performed to ensure it is in running state and retry
sub wait_guest_online {
my $guest = shift;
my $retries = shift // 300;
my $state_check = shift // 0;
# Wait until guest is reachable via ssh
if (script_retry("nmap $guest -PN -p ssh | grep open", delay => 1, retry => $retries, die => 0) != 0) {
# Ensure guest is running
if (($state_check != 0) and (script_run("virsh list --name --state-running | grep $guest") != 0)) {
script_run("virsh destroy $guest");
assert_script_run("virsh start $guest");
script_retry("nmap $guest -PN -p ssh | grep open", delay => 1, retry => $retries);
}
else {
die "Guest $guest ssh service is not up and running";
}
}
}
# Shutdown all guests and wait until they are shutdown
sub shutdown_guests {
## Reboot the guest to ensure the settings are applied
# Shutdown and start the guest because some might have the on_reboot=destroy policy still applied
script_run("virsh shutdown $_") foreach (keys %virt_autotest::common::guests);
# Wait until guests are terminated
wait_guests_shutdown();
}
# wait_guests_shutdown([$timeout]) waits for all guests to be shutdown
sub wait_guests_shutdown {
my $retries = shift // 240;
# Note: Domain-0 is for xen only, but it does not hurt to exclude this also in kvm runs.
# Firstly wait for guest shutdown for a while, turn it off forcibly using "virsh destroy" if timed-out.
# Then wait for guest shutdown again with default "die => 1".
if (script_retry("! virsh list | grep -v Domain-0 | grep running", timeout => 60, delay => 1, retry => $retries, die => 0) != 0) {
script_run("virsh destroy $_") foreach (keys %virt_autotest::common::guests);
}
script_retry("! virsh list | grep -v Domain-0 | grep running", timeout => 60, delay => 1, retry => $retries);
}
# Start all guests and wait until they are online
sub start_guests {
script_run("virsh start '$_'") foreach (keys %virt_autotest::common::guests);
wait_guest_online($_) foreach (keys %virt_autotest::common::guests);
}
#Add common ssh options to host ssh config file to be used for all ssh connections when host tries to ssh to another host/guest.
sub setup_common_ssh_config {
my $ssh_config_file = shift;
$ssh_config_file //= '/root/.ssh/config';
if (script_run("test -f $ssh_config_file") ne 0) {
script_run "mkdir -p " . dirname($ssh_config_file);
assert_script_run("touch $ssh_config_file");
}
if (script_run("grep \"Host \\\*\" $ssh_config_file") ne 0) {
type_string("cat >> $ssh_config_file <<EOF
Host *
UserKnownHostsFile /dev/null
StrictHostKeyChecking no
User root
EOF
");
}
assert_script_run("chmod 600 $ssh_config_file");
record_info("Content of $ssh_config_file after common ssh config setup", script_output("cat $ssh_config_file;ls -lah $ssh_config_file"));
return;
}
#If certain host or guest is assigned a transient hostname from DNS server in company wide space, so the transient hostname becomes the real hostname to be indentified
#on the network.In order to ensure its good ssh connection using predefined hostname or just a more desired one, add alias to its real hostname in host ssh config.
sub add_alias_in_ssh_config {
my ($ssh_config_file, $real_name, $domain_name, $alias_name) = @_;
$ssh_config_file //= '/root/.ssh/config';
$real_name //= '';
$domain_name //= '';
$alias_name //= '';
croak("Real name, domain name and alias name have to be given.") if (($real_name eq '') or ($domain_name eq '') or ($alias_name eq ''));
if (script_run("test -f $ssh_config_file") ne 0) {
script_run "mkdir -p " . dirname($ssh_config_file);
assert_script_run("touch $ssh_config_file");
}
if (script_run("grep -i \"Host $alias_name\" $ssh_config_file") ne 0) {
type_string("cat >> $ssh_config_file <<EOF
Host $alias_name
HostName $real_name.$domain_name
User root
EOF
");
}
assert_script_run("chmod 600 $ssh_config_file");
record_info("Content of $ssh_config_file after adding alias $alias_name to real $real_name.", script_output("cat $ssh_config_file"));
return;
}
#Parsed detaild subnet information, including subnet ip address, network mask, network mask length, gateway ip address, start ip address, end ip address and reverse ip address
#from ipv4 subnet address given.
sub parse_subnet_address_ipv4 {
my $subnet_address = shift;
$subnet_address //= '';
croak("Subnet address argument must be given in the form of \"10.11.12.13/24\"") if (!($subnet_address =~ /\d+\.\d+\.\d+\.\d+\/\d+/));
my $subnet = NetAddr::IP->new($subnet_address);
my $subnet_mask = $subnet->mask();
my $subnet_mask_len = $subnet->masklen();
my $subnet_ipaddr = (split(/\//, $subnet->network()))[0];
my $subnet_ipaddr_rev = ip_reverse($subnet_ipaddr, $subnet_mask_len);
my $subnet_ipaddr_gw = (split(/\//, $subnet->first()))[0];
my $subnet_ipaddr_start = (split(/\//, $subnet->nth(1)))[0];
my $subnet_ipaddr_end = (split(/\//, $subnet->last()))[0];
return ($subnet_ipaddr, $subnet_mask, $subnet_mask_len, $subnet_ipaddr_gw, $subnet_ipaddr_start, $subnet_ipaddr_end, $subnet_ipaddr_rev);
}
#This subroutine receives array reference that contains file or folder name in absolute path form as $backup_target. Then back it up by appending 'backup' and timestamp to its
#original name. If $destination_folder is given, the file or folder will be backed up in it. Otherwise it will be backed up in the orginal parent folder. For example,
#my @something_to_be_backed_up = ('file1', 'folder2', 'folder3'); backup_file(\@something_to_be_backed_up) or backup_file(\@something_to_be_backed_up, '/tmp').
sub backup_file {
my ($backup_target, $destination_folder) = @_;
$backup_target //= '';
$destination_folder //= '';
croak("The file or folder to be backed up must be given.") if ($backup_target eq '');
my $backup_timestamp = localtime();
$backup_timestamp =~ s/ |:/_/g;
$destination_folder =~ s/\/$//g;
my @backup_target_array = @$backup_target;
foreach (@backup_target_array) {
my $backup_target_basename = basename($_);
my $backup_target_dirname = dirname($_);
my $destination_target = $backup_target_basename . '_backup_' . $backup_timestamp;
$destination_target = ($destination_folder eq '' ? "$backup_target_dirname/$destination_target" : "$destination_folder/$destination_target");
script_run("cp -f -r $_ $destination_target");
}
return;
}
#This subroutine use systemctl or service command to manage system service operations, for example, start, stop, disable and etc.
#The system service name to be managed is passed in as the first argument $service_name. The operations to be performed is passed in as the second argument $manage_operation.
#For example, my @myoperations = ('stop', 'disable'); manage_system_service('named', \@myoperations);
sub manage_system_service {
my ($service_name, $manage_operation) = @_;
$service_name //= '';
$manage_operation //= '';
croak("The operation and service name must be given.") if (($service_name eq '') or ($manage_operation eq ''));
my @manage_operations = @$manage_operation;
foreach (@manage_operations) {
script_run("service $service_name $_") if (script_run("systemctl $_ $service_name") ne 0);
}
return;
}
#Standardized system logging is implemented by the rsyslog service. System programs can send syslog messages to the local rsyslogd service which will then redirect those messages
#to remote log servers, namely the centralized log host. The centralized log host can be customized by modifying /etc/rsyslog.conf with desired communication protocol, port, log
#file and log folder. Once syslog reception has been activated and the desired rules for log separation by host has been created, restart the rsyslog service for the configuration
#changes to take effect. An examaple of how to call this subroutine is setup_centralized_log_host('/tmp/temp_log_folder', 'udp', '555').
sub setup_rsyslog_host {
my ($log_host_folder, $log_host_protocol, $log_host_port) = @_;
$log_host_folder //= '/var/log/loghost';
$log_host_protocol //= 'udp';
$log_host_port //= '514';
# Add --gpg-auto-import-keys to zypper_call("in rsyslog")
zypper_call("--gpg-auto-import-keys ref");
zypper_call("--gpg-auto-import-keys in rsyslog");
assert_script_run("mkdir -p $log_host_folder");
my $log_host_protocol_directive = ($log_host_protocol eq 'udp' ? '\$UDPServerRun' : '\$InputTCPServerRun');
if (script_output("cat /etc/rsyslog.conf | grep \"#Setup centralized rsyslog host\"", proceed_on_failure => 1) eq '') {
save_screenshot;
type_string("cat >> /etc/rsyslog.conf <<EOF
#Setup centralized rsyslog host
\\\$ModLoad im${log_host_protocol}.so
$log_host_protocol_directive ${log_host_port}
\\\$template DynamicFile,\"${log_host_folder}/%HOSTNAME%/%syslogfacility-text%.log\"
EOF
");
}
save_screenshot;
record_info("Content of /etc/rsyslog.conf after configured as centralized rsyslog host", script_output("cat /etc/rsyslog.conf"));
my @myoperations = ('start', 'restart', 'status --no-pager');
manage_system_service('syslog', \@myoperations);
save_screenshot;
return;
}
=head2 check_port_state
check_port_state($dst_machine, $dst_port, $retries, $delay)
Check whether given port is open on remote machine. This subroutine accepts four
arguments, dst_machine, dst_port, retries and delay, which are fqdn or ip addr
of remote machine, port on remote machine, the number of retries and delay value
respectively. Default retries is 1 and default delay is 30 seconds. dst_machine
and dst_port have no default value and test will die if the subroutine is called
without being passed value to dst_machine or dst_port.The subroutine will return
1 if the given port is open on the specified remote machine, otherwise it will
return 0.
=cut
sub check_port_state {
my ($dst_machine, $dst_port, $retries, $delay) = @_;
$dst_machine //= "";
$dst_port //= "";
$retries //= 1;
$delay //= 30;
croak('IP address or FQDN should be provided as argument dst_machine or port number should be given as argument dst_port.') if (($dst_machine eq "") or ($dst_port eq ""));
my $port_state = 0;
foreach (1 .. $retries) {
save_screenshot;
if (IO::Socket::INET->new(PeerAddr => "$dst_machine", PeerPort => "$dst_port")) {
save_screenshot;
record_info("Port $dst_port is open", "The port $dst_port is open on machine $dst_machine");
$port_state = 1;
last;
}
save_screenshot;
sleep $delay if ($_ != $retries);
}
record_info("Port $dst_port is not open", "The port $dst_port is not open on machine $dst_machine") if ($port_state == 0);
return $port_state;
}
=head2 is_registered_system
is_registered_system(dst_machine => $machine)
Detect whether system under test is registered. If [dst_machine] is not given,
the default value 'localhost' will be used. Using "transactional-update register"
if 1 is given to [usetrup], otherwise keeping using SUSEConnect.
=cut
sub is_registered_system {
my (%args) = @_;
$args{dst_machine} //= 'localhost';
$args{usetrup} //= 0;
my $cmd1 = $args{usetrup} == 1 ? "transactional-update register" : "SUSEConnect";
$cmd1 .= " --status-text";
my $cmd2 = $cmd1 . " | grep -i \"Not Registered\"";
$cmd2 = "ssh root\@$args{dst_machine} " . "\"$cmd2\"" if ($args{dst_machine} ne 'localhost');
save_screenshot;
if (script_run($cmd2) == 0) {
record_info("System Not Registered");
return 0;
}
record_info("System Registered");
return 1;
}
=head2 do_system_registration
do_system_registration(dst_machine => $machine, activate => 1/0)
Register/de-register system according to argument [activate]. If argument [dst_machine]
is not given, the default value 'localhost' will be used. Using "transactional-update
register" if 1 is given to [usetrup], otherwise keeping using SUSEConnect.
=cut
sub do_system_registration {
my (%args) = @_;
$args{dst_machine} //= 'localhost';
$args{activate} //= 1;
$args{usetrup} //= 0;
my $cmd = $args{usetrup} == 1 ? "transactional-update register" : "SUSEConnect";
$cmd .= $args{activate} == 1 ? " -r " . get_required_var('SCC_REGCODE') . " --url " . get_required_var('SCC_URL') : " -d";
$cmd = "ssh root\@$args{dst_machine} " . "\"$cmd\"" if ($args{dst_machine} ne 'localhost');
script_run($cmd);
save_screenshot;
is_registered_system;
}
=head2 check_system_registration
check_system_registration(dst_machine => $machine)
Check current system registration status. If argument [dst_machine] is not given,
the default value 'localhost' will be used. Using "transactional-update register"
if 1 is given to [usetrup], otherwise keeping using SUSEConnect.
=cut
sub check_system_registration {
my (%args) = @_;
$args{dst_machine} //= 'localhost';
$args{usetrup} //= 0;
my $cmd = $args{usetrup} == 1 ? "transactional-update register" : "SUSEConnect";
$cmd .= " --status-text";
$cmd = "ssh root\@$args{dst_machine} " . "\"$cmd\"" if ($args{dst_machine} ne 'localhost');
record_info("System Registration Status", script_output($cmd, proceed_on_failure => 1));
}
=head2 subscribe_extensions_and_modules
subscribe_extensions_and_modules(dst_machine => $machine, activate => 1/0, reg_exts => $exts)
Any available extensions and modules listed out by SUSEConnect --list-extensions
that do not require additional regcode can be subscribe directly by using command
SUSEConnect -p [extension or module]. Subscription is to be performed on localhost
by default if argument dst_machine is not given any other address, and successful
access to dst_machine via ssh should be guaranteed in advance if dst_machine points
to a remote machine. Deactivation is also supported if argument activate is given
0 explicitly. Multiple extensions or modules can be passed in as a single string
separated by space to argument reg_exts to be subscribed one by one. Using
"transactional-update register" for newer OS like SLE Micro 6.0, which is the more