From 969bc065596476bce5cfed0bb7ffd263f48eb1d5 Mon Sep 17 00:00:00 2001 From: Francois Pons Date: Fri, 5 May 2000 18:45:23 +0000 Subject: *** empty log message *** --- perl-install/detect_devices.pm | 22 +++++++++++++++++++++- perl-install/devices.pm | 1 + perl-install/install2.pm | 13 ++++++------- perl-install/install_any.pm | 10 ++++++++-- perl-install/install_steps_gtk.pm | 6 ++++-- perl-install/install_steps_interactive.pm | 7 +++++-- perl-install/modules.pm | 6 +++--- perl-install/mouse.pm | 7 +------ perl-install/pkgs.pm | 29 +++++++++++++++++++++++++---- perl-install/printer.pm | 13 ++++++++++++- perl-install/printerdrake.pm | 13 ++++++++----- 11 files changed, 94 insertions(+), 33 deletions(-) (limited to 'perl-install') 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; -- cgit v1.2.1