summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/detect_devices.pm22
-rw-r--r--perl-install/devices.pm1
-rw-r--r--perl-install/install2.pm13
-rw-r--r--perl-install/install_any.pm10
-rw-r--r--perl-install/install_steps_gtk.pm6
-rw-r--r--perl-install/install_steps_interactive.pm7
-rw-r--r--perl-install/modules.pm6
-rw-r--r--perl-install/mouse.pm7
-rw-r--r--perl-install/pkgs.pm29
-rw-r--r--perl-install/printer.pm13
-rw-r--r--perl-install/printerdrake.pm13
11 files changed, 94 insertions, 33 deletions
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 79fd47345..8e8415b35 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -16,6 +16,7 @@ use c;
#-#####################################################################################
my @netdevices = map { my $l = $_; map { "$l$_" } (0..3) } qw(eth tr plip fddi);
my %serialprobe = ();
+my $usb_interface = undef;
#-######################################################################################
#- Functions
@@ -243,7 +244,25 @@ sub whatPrinter() {
}
sub whatPrinterPort() {
- grep { tryWrite($_)} qw(/dev/lp0 /dev/lp1 /dev/lp2);
+ grep { tryWrite($_)} qw(/dev/lp0 /dev/lp1 /dev/lp2 /dev/usb/usblp0);
+}
+
+sub probeUSB {
+ require pci_probing::main;
+ require modules;
+ defined($usb_interface) and return $usb_interface;
+ if (($usb_interface) = grep { /usb-/ } map { $_->[1] } pci_probing::main::probe('')) {
+ eval { modules::load($usb_interface, "SERIAL_USB") };
+ if ($@) {
+ $usb_interface = '';
+ } else {
+ modules::load("usbkbd");
+ modules::load("keybdev");
+ }
+ } else {
+ $usb_interface = '';
+ }
+ $usb_interface;
}
sub probeSerialDevices {
@@ -268,6 +287,7 @@ sub probeSerialDevices {
close F;
foreach (values %serialprobe) {
+ $_->{DESCRIPTION} =~ /modem/i and $_->{CLASS} = 'MODEM'; #- hack to make sure a modem is detected.
log::l("probed $_->{DESCRIPTION} of class $_->{CLASS} on device $_->{DEVICE}");
}
}
diff --git a/perl-install/devices.pm b/perl-install/devices.pm
index b0be9577f..ab05f3506 100644
--- a/perl-install/devices.pm
+++ b/perl-install/devices.pm
@@ -84,6 +84,7 @@ sub entry {
@{ ${{"fd" => [ c::S_IFBLK(), 2, 0 ],
"hidbp-mse-" => [ c::S_IFCHR(), 10, 32 ],
"lp" => [ c::S_IFCHR(), 6, 0 ],
+ "usb/usblp" => [ c::S_IFCHR(), 180, 0 ],
"loop" => [ c::S_IFBLK(), 7, 0 ],
"md" => [ c::S_IFBLK(), 9, 0 ],
"nst" => [ c::S_IFCHR(), 9, 128],
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 538ea1cbd..e7f7ee098 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -163,7 +163,7 @@ $o = $::o = {
QUEUE => "lp",
SPOOLDIR => "/var/spool/lpd/lp",
DBENTRY => "PostScript",
- PAPERSIZE => "letter",
+ PAPERSIZE => "",
CRLF => 0,
AUTOSENDEOF => 1,
@@ -387,12 +387,11 @@ sub miscellaneous {
});
my $f = "$o->{prefix}/etc/sysconfig/usb";
- setVarsInSh($f, {
- MOUSE => bool2yesno($o->{mouse}{device} eq "usbmouse"),
- KBD => bool2yesno(int grep { /^keybdev\.c: Adding keyboard/ } detect_devices::syslog()),
- ZIP => bool2yesno(-d "/proc/scsi/usb"),
- getVarsFromSh($f),
- });
+ my %usb = getVarsFromSh($f);
+ $usb{MOUSE} = bool2yesno($o->{mouse}{device} eq "usbmouse");
+ $usb{KBD} = bool2yesno(int grep { /^keybdev\.c: Adding keyboard/ } detect_devices::syslog());
+ $usb{ZIP} = bool2yesno(-d "/proc/scsi/usb");
+ setVarsInSh($f, \%usb);
install_any::fsck_option();
} 'doInstallStep';
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index cff5446ab..22d5c1c2d 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -69,7 +69,6 @@ sub askChangeMedium($$) {
my ($method, $medium) = @_;
my $allow;
do {
- local $::no_theme_change = 1; #- avoid changing theme here!
eval { $allow = changeMedium($method, $medium) };
} while ($@); #- really it is not allowed to die in changeMedium!!! or install will cores with rpmlib!!!
$allow;
@@ -233,9 +232,16 @@ sub getAvailableSpace {
#- 50mb may be a good choice to avoid almost all problem of insuficient space left...
my $minAvailableSize = 50 * sqr(1024);
- int getAvailableSpace_raw($o->{fstab}) * 512 / 1.07 - $minAvailableSize;
+ int (getAvailableSpace_mounted($o->{prefix}) || getAvailableSpace_raw($o->{fstab})) * 512 / 1.07 - $minAvailableSize;
}
+sub getAvailableSpace_mounted {
+ my ($prefix) = @_;
+ my $buf = ' ' x 20000;
+ syscall_('statfs', "$prefix/usr", $buf) or return;
+ my (undef, $blocksize, $size, undef, $free, undef) = unpack "L2L4", $buf;
+ ($free || 1) * $blocksize / 512;
+}
sub getAvailableSpace_raw {
my ($fstab) = @_;
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 37a852ecd..7807eeaa0 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -588,7 +588,10 @@ Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done.
If you don't have it, press Cancel to avoid installation from this Cd-Rom.", pkgs::mediumDescr($o->{packages}, $medium));
#- if not using a cdrom medium, always abort.
- $method eq 'cdrom' && $o->ask_okcancel('', $msg);
+ $method eq 'cdrom' and do {
+ local $my_gtk::grab = 1;
+ $o->ask_okcancel('', $msg);
+ };
};
catch_cdie { $o->install_steps::installPackages($packages); }
sub {
@@ -770,7 +773,6 @@ sub create_steps_window {
$w->set_name($t);
$w->set_usize(0, 7);
gtksignal_connect($w, clicked => sub {
- $::no_theme_change and return; #- no theme wanted!
$::setstep or return; #- just as setstep s
install_theme($o, $t); die "theme_changed\n"
});
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index e8ec6c4fd..f14a9390c 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -621,16 +621,19 @@ sub printerConfig {
require printer;
require printerdrake;
+ log::l("clicked=$clicked\n");
if ($::beginner && !$clicked) {
printerdrake::auto_detect($o) or return;
}
+ log::l("after clicked=$clicked\n");
#- bring interface up for installing ethernet packages but avoid ppp by default,
#- else the guy know what he is doing...
- $o->upNetwork('pppAvoided');
+ #$o->upNetwork('pppAvoided');
eval { add2hash($o->{printer} ||= {}, printer::getinfo($o->{prefix})) };
- printerdrake::main($o->{printer}, $o, sub { $o->pkg_install($_[0]) });
+ $o->{printer}{PAPERSIZE} = $o->{lang} eq 'en' ? 'letter' : 'a4';
+ printerdrake::main($o->{printer}, $o, sub { $o->pkg_install($_[0]) }, sub { $o->upNetwork('pppAvoided') });
}
#------------------------------------------------------------------------------
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 024936c28..bbc1a04f7 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -547,9 +547,9 @@ sub load_thiskind($;&$) {
if ($type eq 'scsi') {
#- hey, we're allowed to pci probe :) let's do a lot of probing!
- #- probe for USB SCSI, make sure keyboard is allowed.
- if (my ($c) = grep { /usb-/ } map { $_->[1] } pci_probing::main::probe('')) {
- eval { load($c, "SERIAL_USB"); load("usbkbd"); load("keybdev"); load("usb-storage", $type); sleep(2); };
+ #- probe for USB SCSI.
+ if (detect_devices::probeUSB()) {
+ eval { load("usb-storage", $type); sleep(2); };
-d "/proc/scsi/usb" or unload("usb-storage");
}
#- probe for parport SCSI.
diff --git a/perl-install/mouse.pm b/perl-install/mouse.pm
index 09ccbc365..8f8607990 100644
--- a/perl-install/mouse.pm
+++ b/perl-install/mouse.pm
@@ -139,23 +139,18 @@ sub detect() {
eval { commands::modprobe("serial") };
my ($r, $wacom) = mouseconfig(); return ($r, $wacom) if $r;
- require pci_probing::main;
- if (my ($c) = grep { /usb-/ } map { $_->[1] } pci_probing::main::probe('')) {
+ if (detect_devices::probeUSB()) {
eval {
- modules::load($c, "SERIAL_USB");
modules::load("usbmouse");
modules::load("mousedev");
};
sleep(1);
if (!$@ && detect_devices::tryOpen("usbmouse")) {
$wacom or modules::unload("serial");
- modules::load("usbkbd");
- modules::load("keybdev");
return name2mouse("USB Mouse"), $wacom;
}
modules::unload("mousedev");
modules::unload("usbmouse");
- modules::unload($c, 'remove_alias');
}
#- defaults to generic ttyS0
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 8c4761872..844b5ec4f 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -177,7 +177,7 @@ sub invCorrectSize { min($_[0], (sqrt(sqr($B) + 4 * $A * ($_[0] - $C)) - $B) / 2
sub selectedSize {
my ($packages) = @_;
- int (sum map { packageSize($_) } grep { packageFlagSelected($_) } values %{$packages->[0]});
+ int (sum map { packageSize($_) - ($_->{installedCumulSize} || 0) } grep { packageFlagSelected($_) } values %{$packages->[0]});
}
sub correctedSelectedSize { correctSize(selectedSize($_[0]) / sqr(1024)) }
@@ -703,10 +703,22 @@ sub selectPackagesToUpgrade($$$;$$) {
#- used for package that are not correctly updated.
#- should only be used when nothing else can be done correctly.
my %upgradeNeedRemove = (
-# 'compat-glibc' => 1,
-# 'compat-libs' => 1,
+ 'libstdc++' => 1,
+ 'compat-glibc' => 1,
+ 'compat-libs' => 1,
);
+ #- these package are not named as ours, need to be translated before working.
+ #- a version may follow to setup a constraint 'installed version greater than'.
+ my %otherPackageToRename = (
+ 'qt' => [ 'qt2', '2.0' ],
+ 'qt1x' => [ 'qt' ],
+ );
+ #- generel purpose for forcing upgrade of package whatever version is.
+ my %packageNeedUpgrade = (
+ 'lilo' => 1, #- this package has been misnamed in 7.0.
+ );
+
#- help removing package which may have different release numbering
my %toRemove; map { $toRemove{$_} = 1 } @{$toRemove || []};
@@ -715,11 +727,17 @@ sub selectPackagesToUpgrade($$$;$$) {
#- the 'installed' property will make a package unable to be selected, look at select.
c::rpmdbTraverse($db, sub {
my ($header) = @_;
- my $p = $packages->[0]{c::headerGetEntry($header, 'name')};
my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
(c::headerGetEntry($header, 'name'). '-' .
c::headerGetEntry($header, 'version'). '-' .
c::headerGetEntry($header, 'release')));
+ my $renaming = $otherPackage && $otherPackageToRename{c::headerGetEntry($header, 'name')};
+ my $name = $renaming &&
+ (!$renaming->[1] || versionCompare(c::headerGetEntry($header, 'version'), $renaming->[1]) >= 0) &&
+ $renaming->[0];
+ $name and $packageNeedUpgrade{$name} = 1; #- keep in mind to force upgrading this package.
+ my $p = $packages->[0]{$name || c::headerGetEntry($header, 'name')};
+
if ($p) {
my $version_cmp = versionCompare(c::headerGetEntry($header, 'version'), packageVersion($p));
my $version_rel_test = $version_cmp > 0 || $version_cmp == 0 &&
@@ -756,6 +774,9 @@ sub selectPackagesToUpgrade($$$;$$) {
#- skip if not installed (package not found in current install).
$skipThis ||= ($count == 0);
+ #- make sure to upgrade package that have to be upgraded.
+ $packageNeedUpgrade{packageName($p)} and $skipThis = 0;
+
#- select the package if it is already installed with a lower version or simply not installed.
unless ($skipThis) {
my $cumulSize;
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index 13f5a3f50..0332b85b6 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -291,7 +291,7 @@ sub getinfo($) {
QUEUE => "lp",
SPOOLDIR => "/var/spool/lpd/lp",
DBENTRY => "PostScript",
- PAPERSIZE => "letter",
+ PAPERSIZE => "",
ASCII_TO_PS => undef,
CRLF => undef,
NUP => 1,
@@ -686,6 +686,17 @@ sub configure_queue($) {
print PRINTCAP "\t:if=$_->{IF}:\n";
print PRINTCAP "\n";
}
+
+ my $useUSB = 0;
+ foreach (values %{$entry->{configured}}) {
+ $useUSB ||= $_->{DEVICE} =~ /usb/;
+ }
+ if ($useUSB) {
+ my $f = "$prefix/etc/sysconfig/usb";
+ my %usb = getVarsFromSh($f);
+ $usb{PRINTER} = "yes";
+ setVarsInSh($f, \%usb);
+ }
}
sub restart_queue($) {
diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm
index 3ae4bba8f..bff8e4e23 100644
--- a/perl-install/printerdrake.pm
+++ b/perl-install/printerdrake.pm
@@ -17,6 +17,7 @@ sub auto_detect {
my ($in) = @_;
{
my $w = $in->wait_message(_("Test ports"), _("Detecting devices..."));
+ detect_devices::probeUSB() and eval { modules::load("printer"); sleep(1); };
eval { modules::load("parport_pc"); modules::load("parport_probe"); modules::load("lp"); };
}
my $b = before_leaving { eval { modules::unload("parport_probe") } };
@@ -112,8 +113,8 @@ _("Password") => {val => \$printer->{NCPPASSWD}, hidden => 1} ],
1;
}
-sub setup_gsdriver($$$) {
- my ($printer, $in, $install) = @_;
+sub setup_gsdriver($$$;$) {
+ my ($printer, $in, $install, $upNetwork) = @_;
my $action;
my @action = qw(ascii ps both done);
my %action = (
@@ -148,6 +149,7 @@ sub setup_gsdriver($$$) {
my %depth_to_col = reverse %col_to_depth;
my $is_uniprint = $db_entry{GSDRIVER} eq "uniprint";
+ $printer->{PAPERSIZE} ||= "letter";
$printer->{RESOLUTION} = @res ? $res[0] || "Default" : "Default" unless member($printer->{RESOLUTION}, @res);
$printer->{ASCII_TO_PS} = $db_entry{GSDRIVER} eq 'POSTSCRIPT' unless defined($printer->{ASCII_TO_PS});
$printer->{CRLF} = $db_entry{DESCR} =~ /HP/ unless defined($printer->{CRLF});
@@ -207,6 +209,7 @@ _("Extra Text options") => \$printer->{TEXTONLYOPTIONS},
{
my $w = $in->wait_message('', _("Printing test page(s)..."));
+ $upNetwork and do { &$upNetwork(); undef $upNetwork; sleep(1) };
printer::restart_queue(printer::default_queue($printer->{QUEUE}));
@lpq_output = printer::print_pages(printer::default_queue($printer->{QUEUE}), @testpages);
}
@@ -226,8 +229,8 @@ Does it work properly?"), 1) ? 'done' : 'change';
}
#- Program entry point.
-sub main($$$) {
- my ($printer, $in, $install) = @_;
+sub main($$$;$) {
+ my ($printer, $in, $install, $upNetwork) = @_;
my ($queue, $continue) = ('', 1);
while ($continue) {
@@ -293,7 +296,7 @@ _("Printer Connection") => { val => \$printer->{str_type}, not_edit => 1, list =
}
#- configure ghostscript driver to be used.
- if (!$continue && setup_gsdriver($printer, $in, $install)) {
+ if (!$continue && setup_gsdriver($printer, $in, $install, $printer->{TYPE} ne 'LOCAL' && $upNetwork)) {
delete $printer->{OLD_QUEUE}
if $printer->{QUEUE} ne $printer->{OLD_QUEUE} && $printer->{configured}{$printer->{QUEUE}};
$continue = !$::beginner;
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-01 13:51:20 +0000