File: osutils.pm

package info (click to toggle)
os-autoinst 4.5.1527308405.8b586d5-4.1
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 22,688 kB
  • sloc: perl: 10,424; cpp: 1,527; python: 217; makefile: 211; sh: 71; xml: 11
file content (130 lines) | stat: -rw-r--r-- 4,213 bytes parent folder | download
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
# Copyright (C) 2017 SUSE LLC
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License

package osutils;

require 5.002;
use strict;
use warnings;

use Carp;
use base 'Exporter';
use Mojo::File 'path';
use bmwqemu 'diag';
use POSIX ':sys_wait_h';
use Symbol 'gensym';
use IPC::Open3;
use IO::Select;

our @EXPORT_OK = qw(
  dd_gen_params
  find_bin
  gen_params
  qv
  quote
  runcmd
);

# An helper to lookup into a folder and find an executable file between given candidates
# First argument is the directory, the remainining are the candidates.
sub find_bin {
    my ($dir, @candidates) = @_;

    foreach my $t_bin (map { path($dir, $_) } @candidates) {
        return $t_bin if -e $t_bin && -x $t_bin;
    }
    return;
}

## no critic
# An helper to full a parameter list, typically used to build option arguments for executing external programs.
# mimics perl's push, this why it's a prototype: first argument is the array, second is the argument option and the third is the parameter.
# the (optional) hash argument which can include the prefix argument for the array, if not specified '-' (dash) is assumed by default
# and if parameter should not be quoted, for that one can use no_quotes. NOTE: this is applicable for string parameters only.
# if the parameter is equal to "", the value is not pushed to the array.
# For example: gen_params \@params, 'device', 'scsi', prefix => '--', no_quotes => 1;
sub gen_params(\@$$;%) {
    my ($array, $argument, $parameter, %args) = @_;

    return unless ($parameter);
    $args{prefix} = "-" unless $args{prefix};

    if (ref($parameter) eq "") {
        $parameter = quote($parameter) if $parameter =~ /\s+/ && !$args{no_quotes};
        push(@$array, $args{prefix} . "${argument}", $parameter);
    }
    elsif (ref($parameter) eq "ARRAY") {
        push(@$array, $args{prefix} . "${argument}", join(',', @$parameter));
    }

}

# doubledash shortcut version. Same can be achieved with gen_params.
sub dd_gen_params(\@$$) {
    my ($array, $argument, $parameter) = @_;
    gen_params(@{$array}, $argument, $parameter, prefix => "--");
}

# It merely splits a string into pieces interpolating variables inside it.
# e.g.  gen_params @params, 'drive', "file=$basedir/l$i,cache=unsafe,if=none,id=hd$i,format=$vars->{HDDFORMAT}" can be rewritten as
#       gen_params @params, 'drive', [qv "file=$basedir/l$i cache=unsafe if=none id=hd$i format=$vars->{HDDFORMAT}"]
sub qv($) {
    split /\s+|\h+|\r+/, $_[0];
}

# Add single quote mark to string
# Mainly use in the case of multiple kernel parameters to be passed to the -append option
# and they need to be quoted using single or double quotes
sub quote {
    "\'" . $_[0] . "\'";
}

# Open a process to run external program and check its return status
sub runcmd {
    diag "running " . join(' ', @_);

    my ($wtr, $rdr, $err);
    $err = gensym;
    my $pid = open3($wtr, $rdr, $err, @_);
    die "couldn't open: $!" unless defined $pid;
    close($wtr) or die "couldn't close fh: $!";

    my $s = IO::Select->new();
    $s->add($rdr, $err);
    while (my @ready = $s->can_read()) {
        for my $fh (@ready) {
            if (sysread($fh, my $buf, 4096)) {
                diag $buf if ($fh == $rdr);
                diag $buf if ($fh == $err);
            }
            else {
                $s->remove($fh);
            }
        }
    }
    close($rdr) or die "couldn't close fh: $!";
    close($err) or die "couldn't close fh: $!";

    my $status;
    waitpid $pid, 0;
    $status = $?;
    diag "runcmd pid $pid returned $status";

    my $exit_code = $status >> 8;
    die "runcmd failed with exit code $exit_code" unless ($exit_code == 0);
    return $exit_code;
}
## use critic

1;