line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# (c) Jan Gehring |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Rex::Pkg::Base; |
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
26
|
use v5.12.5; |
|
2
|
|
|
|
|
7
|
|
8
|
2
|
|
|
2
|
|
12
|
use warnings; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
47
|
|
9
|
2
|
|
|
2
|
|
466
|
use Rex::Helper::Run; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
140
|
|
10
|
2
|
|
|
2
|
|
13
|
use Rex::Interface::Exec; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
9
|
|
11
|
2
|
|
|
2
|
|
46
|
use Net::OpenSSH::ShellQuoter; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
21
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '1.14.2.2'; # TRIAL VERSION |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
1
|
|
|
1
|
0
|
2
|
my $that = shift; |
17
|
1
|
|
33
|
|
|
6
|
my $proto = ref($that) || $that; |
18
|
1
|
|
|
|
|
3
|
my $self = {@_}; |
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
|
|
2
|
bless( $self, $proto ); |
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
|
|
3
|
return $self; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub is_installed { |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
0
|
0
|
0
|
my ( $self, $pkg, $option ) = @_; |
28
|
0
|
|
|
|
|
0
|
my $version = $option->{version}; |
29
|
|
|
|
|
|
|
|
30
|
0
|
0
|
|
|
|
0
|
Rex::Logger::debug( |
31
|
|
|
|
|
|
|
"Checking if $pkg" . ( $version ? "-$version" : "" ) . " is installed" ); |
32
|
|
|
|
|
|
|
|
33
|
0
|
|
|
|
|
0
|
my @pkg_info = grep { $_->{name} eq $pkg } $self->get_installed(); |
|
0
|
|
|
|
|
0
|
|
34
|
0
|
0
|
|
|
|
0
|
@pkg_info = grep { $_->{version} eq $version } @pkg_info if defined $version; |
|
0
|
|
|
|
|
0
|
|
35
|
|
|
|
|
|
|
|
36
|
0
|
0
|
|
|
|
0
|
unless (@pkg_info) { |
37
|
0
|
0
|
|
|
|
0
|
Rex::Logger::debug( |
38
|
|
|
|
|
|
|
"$pkg" . ( $version ? "-$version" : "" ) . " is NOT installed." ); |
39
|
0
|
|
|
|
|
0
|
return 0; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
Rex::Logger::debug( |
43
|
0
|
0
|
|
|
|
0
|
"$pkg" . ( $version ? "-$version" : "" ) . " is installed." ); |
44
|
0
|
|
|
|
|
0
|
return 1; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub install { |
49
|
0
|
|
|
0
|
0
|
0
|
my ( $self, $pkg, $option ) = @_; |
50
|
|
|
|
|
|
|
|
51
|
0
|
0
|
|
|
|
0
|
if ( $self->is_installed( $pkg, $option ) ) { |
52
|
0
|
|
|
|
|
0
|
Rex::Logger::info("$pkg is already installed"); |
53
|
0
|
|
|
|
|
0
|
return 1; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
0
|
$self->update( $pkg, $option ); |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
0
|
return 1; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub update { |
62
|
1
|
|
|
1
|
0
|
6459
|
my ( $self, $pkg, $option ) = @_; |
63
|
|
|
|
|
|
|
|
64
|
1
|
|
50
|
|
|
7
|
my $version = $option->{'version'} || ''; |
65
|
1
|
|
50
|
|
|
6
|
my $env = $option->{'env'} || {}; |
66
|
|
|
|
|
|
|
|
67
|
1
|
50
|
|
|
|
10
|
Rex::Logger::debug( "Installing $pkg" . ( $version ? "-$version" : "" ) ); |
68
|
1
|
|
|
|
|
2
|
my $cmd; |
69
|
1
|
50
|
33
|
|
|
6
|
if ( ( $pkg =~ /\*/ ) |
70
|
|
|
|
|
|
|
&& defined( $self->{commands}->{install_glob} ) ) |
71
|
|
|
|
|
|
|
{ |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# quote the pkg name so it won't error when ran |
74
|
0
|
|
|
|
|
0
|
my $exec = Rex::Interface::Exec->create; |
75
|
0
|
|
|
|
|
0
|
my $quoter = Net::OpenSSH::ShellQuoter->quoter( $exec->shell->name ); |
76
|
0
|
|
|
|
|
0
|
$pkg = $quoter->quote($pkg); |
77
|
0
|
|
|
|
|
0
|
$cmd = sprintf $self->{commands}->{install_glob}, $pkg; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
else { |
80
|
1
|
|
|
|
|
8
|
$cmd = sprintf $self->{commands}->{install}, $pkg; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# not compatible with globs, so skip over this |
83
|
1
|
50
|
|
|
|
23
|
if ( exists $option->{version} ) { |
84
|
|
|
|
|
|
|
$cmd = sprintf $self->{commands}->{install_version}, $pkg, |
85
|
0
|
|
|
|
|
0
|
$option->{version}; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
1
|
|
|
|
|
6
|
my $f = i_run $cmd, fail_ok => 1, env => $env; |
90
|
|
|
|
|
|
|
|
91
|
1
|
50
|
|
|
|
10
|
unless ( $? == 0 ) { |
92
|
0
|
|
|
|
|
0
|
Rex::Logger::info( "Error installing $pkg.", "warn" ); |
93
|
0
|
|
|
|
|
0
|
Rex::Logger::debug($f); |
94
|
0
|
|
|
|
|
0
|
die("Error installing $pkg"); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
1
|
|
|
|
|
15
|
Rex::Logger::debug("$pkg successfully installed."); |
98
|
|
|
|
|
|
|
|
99
|
1
|
|
|
|
|
48
|
return 1; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub update_system { |
103
|
0
|
|
|
0
|
0
|
0
|
my ( $self, %option ) = @_; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# default is to update packages |
106
|
0
|
0
|
|
|
|
0
|
$option{update_packages} = 1 if ( !exists $option{update_packages} ); |
107
|
|
|
|
|
|
|
|
108
|
0
|
0
|
|
|
|
0
|
if ( !exists $self->{commands}->{update_system} ) { |
109
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("Not supported under this OS"); |
110
|
0
|
|
|
|
|
0
|
return; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
0
|
0
|
|
|
|
0
|
if ( $option{update_metadata} ) { |
114
|
0
|
|
|
|
|
0
|
$self->update_pkg_db(%option); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
0
|
0
|
|
|
|
0
|
if ( $option{update_packages} ) { |
118
|
0
|
|
|
|
|
0
|
my $cmd = $self->{commands}->{update_system}; |
119
|
0
|
|
|
|
|
0
|
my $f = i_run $cmd, fail_ok => 1; |
120
|
|
|
|
|
|
|
|
121
|
0
|
0
|
|
|
|
0
|
unless ( $? == 0 ) { |
122
|
0
|
|
|
|
|
0
|
Rex::Logger::debug($f); |
123
|
0
|
|
|
|
|
0
|
die("Error updating system"); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
0
|
0
|
|
|
|
0
|
if ( $option{dist_upgrade} ) { |
128
|
0
|
0
|
|
|
|
0
|
if ( !exists $self->{commands}->{dist_update_system} ) { |
129
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("dist upgrades not supported under this OS"); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
else { |
132
|
0
|
|
|
|
|
0
|
my $cmd = $self->{commands}->{dist_update_system}; |
133
|
0
|
|
|
|
|
0
|
my $f = i_run $cmd, fail_ok => 1; |
134
|
|
|
|
|
|
|
|
135
|
0
|
0
|
|
|
|
0
|
unless ( $? == 0 ) { |
136
|
0
|
|
|
|
|
0
|
Rex::Logger::debug($f); |
137
|
0
|
|
|
|
|
0
|
die("Error dist-updating system"); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("System successfully updated."); |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
0
|
return 1; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub remove { |
148
|
0
|
|
|
0
|
0
|
0
|
my ( $self, $pkg ) = @_; |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("Removing $pkg"); |
151
|
0
|
|
|
|
|
0
|
my $cmd; |
152
|
0
|
0
|
0
|
|
|
0
|
if ( ( $pkg =~ /\*/ ) |
153
|
|
|
|
|
|
|
&& defined( $self->{commands}->{remove_glob} ) ) |
154
|
|
|
|
|
|
|
{ |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# quote the pkg name so it won't error when ran |
157
|
0
|
|
|
|
|
0
|
my $exec = Rex::Interface::Exec->create; |
158
|
0
|
|
|
|
|
0
|
my $quoter = Net::OpenSSH::ShellQuoter->quoter( $exec->shell->name ); |
159
|
0
|
|
|
|
|
0
|
$pkg = $quoter->quote($pkg); |
160
|
0
|
|
|
|
|
0
|
$cmd = sprintf $self->{commands}->{remove_glob}, $pkg; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
else { |
163
|
0
|
|
|
|
|
0
|
$cmd = sprintf $self->{commands}->{remove}, $pkg; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
0
|
my $f = i_run $cmd, fail_ok => 1; |
167
|
|
|
|
|
|
|
|
168
|
0
|
0
|
|
|
|
0
|
unless ( $? == 0 ) { |
169
|
0
|
|
|
|
|
0
|
Rex::Logger::info( "Error removing $pkg.", "warn" ); |
170
|
0
|
|
|
|
|
0
|
Rex::Logger::debug($f); |
171
|
0
|
|
|
|
|
0
|
die("Error removing $pkg"); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("$pkg successfully removed."); |
175
|
|
|
|
|
|
|
|
176
|
0
|
|
|
|
|
0
|
return 1; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub purge { |
180
|
0
|
|
|
0
|
0
|
0
|
my ( $self, $pkg ) = @_; |
181
|
0
|
0
|
|
|
|
0
|
return 1 if ( !exists $self->{commands}->{purge} ); |
182
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("Purging $pkg"); |
183
|
0
|
|
|
|
|
0
|
my $cmd = sprintf $self->{commands}->{purge}, $pkg; |
184
|
|
|
|
|
|
|
|
185
|
0
|
|
|
|
|
0
|
my $f = i_run $cmd, fail_ok => 1; |
186
|
|
|
|
|
|
|
|
187
|
0
|
0
|
|
|
|
0
|
unless ( $? == 0 ) { |
188
|
0
|
|
|
|
|
0
|
Rex::Logger::info( "Error purging $pkg.", "warn" ); |
189
|
0
|
|
|
|
|
0
|
Rex::Logger::debug($f); |
190
|
0
|
|
|
|
|
0
|
die("Error purging $pkg"); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("$pkg successfully purged."); |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
0
|
return 1; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub update_pkg_db { |
199
|
0
|
|
|
0
|
0
|
0
|
my ( $self, %option ) = @_; |
200
|
|
|
|
|
|
|
|
201
|
0
|
0
|
|
|
|
0
|
if ( !exists $self->{commands}->{update_package_db} ) { |
202
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("Not supported under this OS"); |
203
|
0
|
|
|
|
|
0
|
return; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
0
|
my $cmd = $self->{commands}->{update_package_db}; |
207
|
0
|
|
|
|
|
0
|
i_run $cmd, fail_ok => 1; |
208
|
0
|
0
|
|
|
|
0
|
if ( $? != 0 ) { |
209
|
0
|
|
|
|
|
0
|
die("Error updating package database"); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub bulk_install { |
214
|
0
|
|
|
0
|
0
|
0
|
Rex::Logger::info( |
215
|
|
|
|
|
|
|
"Installing bulk packages not supported on this platform. Falling back to one by one method", |
216
|
|
|
|
|
|
|
"warn" |
217
|
|
|
|
|
|
|
); |
218
|
|
|
|
|
|
|
|
219
|
0
|
|
|
|
|
0
|
my ( $self, $packages_aref, $option ) = @_; |
220
|
0
|
|
|
|
|
0
|
for my $pkg_to_install ( @{$packages_aref} ) { |
|
0
|
|
|
|
|
0
|
|
221
|
0
|
|
|
|
|
0
|
$self->install( $pkg_to_install, $option ); |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
0
|
|
|
|
|
0
|
return 1; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub add_repository { |
228
|
0
|
|
|
0
|
0
|
0
|
my ( $self, %data ) = @_; |
229
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("Not supported under this OS"); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub rm_repository { |
233
|
0
|
|
|
0
|
0
|
0
|
my ( $self, $name ) = @_; |
234
|
0
|
|
|
|
|
0
|
Rex::Logger::debug("Not supported under this OS"); |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub diff_package_list { |
238
|
1
|
|
|
1
|
0
|
1787
|
my ( $self, $list1, $list2 ) = @_; |
239
|
|
|
|
|
|
|
|
240
|
1
|
|
|
|
|
2
|
my @old_installed = @{$list1}; |
|
1
|
|
|
|
|
3
|
|
241
|
1
|
|
|
|
|
2
|
my @new_installed = @{$list2}; |
|
1
|
|
|
|
|
3
|
|
242
|
|
|
|
|
|
|
|
243
|
1
|
|
|
|
|
3
|
my @modifications; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# getting modifications of old packages |
246
|
|
|
|
|
|
|
OLD_PKG: |
247
|
1
|
|
|
|
|
2
|
for my $old_pkg (@old_installed) { |
248
|
|
|
|
|
|
|
NEW_PKG: |
249
|
3
|
|
|
|
|
5
|
for my $new_pkg (@new_installed) { |
250
|
6
|
100
|
|
|
|
14
|
if ( $old_pkg->{name} eq $new_pkg->{name} ) { |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# flag the package as found in new package list, |
253
|
|
|
|
|
|
|
# to find removed and new ones. |
254
|
2
|
|
|
|
|
4
|
$old_pkg->{found} = 1; |
255
|
2
|
|
|
|
|
3
|
$new_pkg->{found} = 1; |
256
|
|
|
|
|
|
|
|
257
|
2
|
100
|
|
|
|
6
|
if ( $old_pkg->{version} ne $new_pkg->{version} ) { |
258
|
1
|
|
|
|
|
3
|
push @modifications, { %{$new_pkg}, action => 'updated' }; |
|
1
|
|
|
|
|
5
|
|
259
|
|
|
|
|
|
|
} |
260
|
2
|
|
|
|
|
5
|
next OLD_PKG; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# getting removed old packages |
266
|
1
|
|
|
|
|
2
|
push @modifications, map { $_->{action} = 'removed'; $_ } |
|
1
|
|
|
|
|
4
|
|
267
|
1
|
|
|
|
|
3
|
grep { !exists $_->{found} } @old_installed; |
|
3
|
|
|
|
|
7
|
|
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# getting new packages |
270
|
1
|
|
|
|
|
1
|
push @modifications, map { $_->{action} = 'installed'; $_ } |
|
1
|
|
|
|
|
2
|
|
271
|
1
|
|
|
|
|
3
|
grep { !exists $_->{found} } @new_installed; |
|
3
|
|
|
|
|
6
|
|
272
|
|
|
|
|
|
|
|
273
|
1
|
|
|
|
|
3
|
for (@modifications) { |
274
|
3
|
|
|
|
|
5
|
delete $_->{found}; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
1
|
|
|
|
|
4
|
return @modifications; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
1; |