blob: 3f281b5c65d56f83c63157cbc7879dbe04dc7f09 (
plain)
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
|
package log; # $Id$
use diagnostics;
use strict;
use vars qw(*LOG *LOG2);
use c;
#-#####################################################################################
#- Globals
#-#####################################################################################
my $logOpen = 0;
my $logDebugMessages = 0;
#-######################################################################################
#- Functions
#-######################################################################################
sub F() { *LOG }
sub l {
$logOpen or openLog();
if ($::testing) {
print STDERR @_, "\n";
} elsif ($::isStandalone) {
c::syslog(c::LOG_WARNING(), join("", @_));
} elsif ($::isInstall) {
print LOG "* ", @_, "\n";
print LOG2 "* ", @_, "\n";
} else {
print STDERR @_, "\n";
}
}
sub ld { $logDebugMessages and &l }
sub w { &l }
sub openLog(;$) {
if ($::isInstall) {
if ($_[0]) { #- useLocal
open LOG, "> $_[0]"; #-#
} else {
open LOG, "> /dev/tty3"; #-#
}
open LOG2, ">> /tmp/ddebug.log"; #-#
select((select(LOG), $| = 1)[0]);
select((select(LOG2), $| = 1)[0]);
}
exists $ENV{DEBUG} and $logDebugMessages = 1;
$logOpen = 1;
}
sub closeLog() {
if ($::isStandalone) {
c::closelog();
} else { close LOG; close LOG2 }
}
sub explanations { c::syslog(c::LOG_INFO()|c::LOG_LOCAL1(), "@_") }
1;
|
='#n262'>262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
package do_pkgs; # $Id$
sub do_pkgs {
my ($in) = @_;
($::isInstall ? 'do_pkgs_during_install' : 'do_pkgs_standalone')->new($in);
}
################################################################################
package do_pkgs_common;
use common;
sub ensure_is_installed {
my ($do, $pkg, $o_file, $b_auto) = @_;
if ($o_file ? -e "$::prefix$o_file" : $do->is_installed($pkg)) {
return 1;
}
$do->in->ask_okcancel(N("Warning"), N("The package %s needs to be installed. Do you want to install it?", $pkg), 1)
or return if !$b_auto && $do->in;
if (!$do->install($pkg)) {
$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg)) if $do->in;
return;
}
if ($o_file && ! -e "$::prefix$o_file") {
$do->in->ask_warn(N("Error"), N("Mandatory package %s is missing", $pkg)) if $do->in;
return;
}
1;
}
sub ensure_are_installed {
my ($do, $pkgs, $b_auto) = @_;
my @not_installed = difference2($pkgs, [ $do->are_installed(@$pkgs) ]) or return 1;
$do->in->ask_okcancel(N("Warning"), N("The following packages need to be installed:\n") . join(', ', @not_installed), 1)
or return if !$b_auto && $do->in;
if (!$do->install(@not_installed)) {
if ($do->in) {
$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $not_installed[0]));
} else {
log::l("Could not install packages: " . join(' ', @not_installed));
}
return;
}
1;
}
sub ensure_binary_is_installed {
my ($do, $pkg, $binary, $b_auto) = @_;
if (!whereis_binary($binary, $::prefix)) {
$do->in->ask_okcancel(N("Warning"), N("The package %s needs to be installed. Do you want to install it?", $pkg), 1)
or return if !$b_auto && $do->in;
if (!$do->install($pkg)) {
$do->in->ask_warn(N("Error"), N("Could not install the %s package!", $pkg)) if $do->in;
return;
}
}
if (!whereis_binary($binary, $::prefix)) {
$do->in->ask_warn(N("Error"), N("Mandatory package %s is missing", $pkg)) if $do->in;
return;
}
1;
}
sub ensure_is_installed_if_available {
my ($do, $pkg, $file) = @_;
if (-e "$::prefix$file" || $::testing) {
1;
} else {
$do->what_provides($pkg) && $do->install($pkg);
}
}
sub is_available {
my ($do, $name) = @_;
$do->are_available($name);
}
sub is_installed {
my ($do, $name) = @_;
$do->are_installed($name);
}
#- takes something like "ati-kernel"
#- returns:
#- - the various ati-kernel-2.6.XX-XXmdk available for the installed kernels
#- - dkms-ati if available
sub check_kernel_module_packages {
my ($do, $base_name) = @_;
require bootloader;
my @test_rpms = (
'dkms-' . $base_name,
map { $base_name . '-kernel-' . bootloader::vmlinuz2version($_) } bootloader::installed_vmlinuz()
);
@rpms = $do->are_available(@test_rpms);
@rpms = $do->are_installed(@test_rpms) if !@rpms;
@rpms or return;
log::l("those kernel module packages can be installed: " . join(' ', @rpms));
\@rpms;
}
################################################################################
package do_pkgs_during_install;
use run_program;
use common;
our @ISA = qw(do_pkgs_common);
sub new {
my ($type, $in) = @_;
$in->isa('interactive') or undef $in;
require install::pkgs;
bless { in => $in, o => $::o }, $type;
}
sub in {
my ($do) = @_;
$do->{in};
}
sub install {
my ($do, @l) = @_;
log::l("do_pkgs_during_install::install");
if ($::testing) {
log::l("i would install packages " . join(' ', @l));
1;
} else {
$do->{o}->pkg_install(@l);
1; #- HACK, need better fix in install::steps::pkg_install()
}
}
sub what_provides {
my ($do, $name) = @_;
map { $_->name } install::pkgs::packagesProviding($do->{o}{packages}, $name);
}
sub are_available {
my ($do, @pkgs) = @_;
grep { install::pkgs::packageByName($do->{o}{packages}, $_) } @pkgs;
}
sub are_installed {
my ($do, @l) = @_;
grep {
my $p = install::pkgs::packageByName($do->{o}{packages}, $_);
$p && $p->flag_available;
} @l;
}
sub remove {
my ($do, @l) = @_;
@l = grep {
my $p = install::pkgs::packageByName($do->{o}{packages}, $_);
install::pkgs::unselectPackage($do->{o}{packages}, $p) if $p;
$p;
} @l;
run_program::rooted($::prefix, 'rpm', '-e', @l);
}
sub remove_nodeps {
my ($do, @l) = @_;
@l = grep {
my $p = install::pkgs::packageByName($do->{o}{packages}, $_);
if ($p) {
$p->set_flag_requested(0);
$p->set_flag_required(0);
}
$p;
} @l;
run_program::rooted($::prefix, 'rpm', '-e', '--nodeps', @l);
}
################################################################################
package do_pkgs_standalone;
use run_program;
use common;
use log;
use feature qw(state);
our @ISA = qw(do_pkgs_common);
sub new {
my ($type, $o_in) = @_;
bless { in => $o_in }, $type;
}
sub in {
my ($do) = @_;
$do->{in};
}
sub install {
my ($do, @l) = @_;
return 1 if listlength(are_installed($do, @l)) == @l;
if ($::testing) {
log::l("i would install packages " . join(' ', @l));
return 1;
}
my @options = ('--allow-medium-change', '--auto', '--no-verify-rpm', '--expect-install', @l);
my $ret;
if (check_for_xserver() && -x '/usr/bin/gurpmi') {
$ret = system('gurpmi', @options) == 0;
} else {
my $_wait = $do->in && $do->in->wait_message(N("Please wait"), N("Installing packages..."));
$do->in->suspend if $do->in;
log::explanations("installing packages @l");
#- --expect-install added in urpmi 4.6.11
$ret = system('urpmi', '--gui', @options) == 0;
$do->in->resume if $do->in;
}
$ret;
}
sub are_available {
my ($_do, @pkgs) = @_;
my %pkgs = map { $_ => 1 } @pkgs;
require urpm::media;
state $urpm;
eval {
if (!$urpm) {
$urpm = urpm->new;
$urpm->{log} = \&log::l;
urpm::media::configure($urpm,
nocheck_access => 1,
no_skiplist => 1,
no_second_pass => 1);
}
map { $_->name } grep { $pkgs{$_->name} } @{$urpm->{depslist} || []};
};
}
sub what_provides {
my ($_do, $name) = @_;
split('\|', chomp_(run_program::get_stdout('urpmq', $name)));
}
sub are_installed {
my ($_do, @l) = @_;
@l or return;
my @l2;
my $query_all = (any { /\*/ } @l) ? 'a' : '';
run_program::run('/bin/rpm', '>', \@l2, '-q' . $query_all, '--qf', "%{name}\n", @l); #- do not care about the return value
$query_all ? chomp_(@l2) : intersection(\@l, [ chomp_(@l2) ]); #- can not return directly @l2 since it contains things like "package xxx is not installed"
}
sub remove {
my ($do, @l) = @_;
my $_wait = $do->in && $do->in->wait_message(N("Please wait"), N("Removing packages..."));
$do->in->suspend if $do->in;
log::explanations("removing packages @l");
my $ret = system('rpm', '-e', @l) == 0;
$do->in->resume if $do->in;
$ret;
}
sub remove_nodeps {
my ($do, @l) = @_;
remove($do, '--nodeps', @l) == 0;
}