From de7d4baf2978f851c572282fe54355c94c69259e Mon Sep 17 00:00:00 2001 From: Francois Pons Date: Fri, 19 May 2000 17:15:36 +0000 Subject: *** empty log message *** --- perl-install/ChangeLog | 4 ++++ perl-install/common.pm | 28 +++++++++++++++++++++++++--- perl-install/detect_devices.pm | 3 +++ perl-install/install_any.pm | 6 ++++-- perl-install/install_steps.pm | 4 +++- perl-install/install_steps_gtk.pm | 2 +- perl-install/keyboard.pm | 15 ++++++++------- perl-install/partition_table.pm | 9 +++++++-- perl-install/pkgs.pm | 33 +++++++++++++++++++++++++-------- perl-install/printer.pm | 7 +++++-- perl-install/share/list.sparc | 2 +- 11 files changed, 86 insertions(+), 27 deletions(-) (limited to 'perl-install') diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog index 55b7e6547..152193099 100644 --- a/perl-install/ChangeLog +++ b/perl-install/ChangeLog @@ -1,3 +1,7 @@ +2000-05-19 François Pons + + * *.pm: sparc and sparc64 update, a long to do again. + 2000-05-09 Pixel * install_any.pm (kdeicons_postinstall): the URL link to doc must diff --git a/perl-install/common.pm b/perl-install/common.pm index 34e869636..643201b3e 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -2,15 +2,15 @@ package common; use diagnostics; use strict; -use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $cancel $SECTORSIZE); +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $cancel $SECTORSIZE %compat_arch); @ISA = qw(Exporter); %EXPORT_TAGS = ( - common => [ qw(__ even odd arch min max sqr sum and_ or_ sign product bool invbool listlength bool2text bool2yesno text2bool to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX formatLines deref) ], + common => [ qw(__ even odd arch better_arch compat_arch min max sqr sum and_ or_ sign product bool invbool listlength bool2text bool2yesno text2bool to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX formatLines deref) ], functional => [ qw(fold_left compose map_index grep_index map_each grep_each list2kv map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie combine) ], file => [ qw(dirname basename touch all glob_ cat_ output symlinkf chop_ mode typeFromMagic expand_symlinks) ], system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ salt getVarsFromSh setVarsInSh setVarsInCsh substInFile availableRam availableMemory removeXiBSuffix template2file formatTime unix2dos setVirtual) ], - constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ], + constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE %compat_arch) ], ); @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; @@ -22,6 +22,22 @@ $printable_chars = "\x20-\x7E"; $sizeof_int = psizeof("i"); $bitof_int = $sizeof_int * 8; $SECTORSIZE = 512; +%compat_arch = ( #- compatibilty arch mapping. + 'noarch' => undef, + 'i386' => 'noarch', + 'i486' => 'i386', + 'i586' => 'i486', + 'i686' => 'i586', + 'i786' => 'i686', + 'k6' => 'i586', + 'k7' => 'k6', + 'k8' => 'k7', + 'ppc' => 'noarch', + 'alpha' => 'noarch', + 'sparc' => 'noarch', + 'sparc32' => 'sparc', + 'sparc64' => 'sparc32', + ); #-##################################################################################### #- Functions @@ -125,6 +141,12 @@ sub arch() { no strict; $Config{archname} =~ /(.*)-/ and $1; } +sub better_arch { + my ($new, $old) = @_; + while ($new && $new != $old) { $new = $compat_arch{$_} } + $new; +} +sub compat_arch { better_arch(arch(), $_[0]) } sub touch { my ($f) = @_; diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index ad35871cc..bed7d98ee 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -112,6 +112,9 @@ sub getSCSI() { sub getIDE() { my @idi; + #- what about a system with absolutely no IDE on it, like some sparc machine. + hasIDE() or return (); + #- Great. 2.2 kernel, things are much easier and less error prone. foreach my $d (sort @{[glob_('/proc/ide/hd*')]}) { my ($t) = chop_(cat_("$d/media")); diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index f953785b6..9e02cb149 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -238,9 +238,11 @@ sub getAvailableSpace { sub getAvailableSpace_mounted { my ($prefix) = @_; my $buf = ' ' x 20000; - syscall_('statfs', "$prefix/usr", $buf) or return; + my $dir = -d "$prefix/usr" ? "$prefix/usr" : "$prefix"; + syscall_('statfs', $dir, $buf) or return; my (undef, $blocksize, $size, undef, $free, undef) = unpack "L2L4", $buf; - ($free || 1) * $blocksize; + log::l("space free on $dir is $free blocks of $blocksize bytes"); + $free * $blocksize || 1; } sub getAvailableSpace_raw { my ($fstab) = @_; diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 2b37f9dfe..fc0c42465 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -320,13 +320,15 @@ Either your cdrom drive or your cdrom is defective. Check the cdrom on an installed computer using \"rpm -qpl Mandrake/RPMS/*.rpm\" ") if grep { m|read failed: Input/output error| } cat_("$o->{prefix}/root/install.log"); - -x "$o->{prefix}/usr/bin/dumpkeys" or $::testing or die + if (arch() !~ /^sparc/) { #- TODO restore it as may be needed for sparc + -x "$o->{prefix}/usr/bin/dumpkeys" or $::testing or die "Some important packages didn't get installed properly. Please switch to console 2 (using ctrl-alt-f2) and look at the log file /tmp/ddebug.log Consoles 1,3,4,7 may also contain interesting information"; + } pkgs::done_db(); diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index 483936295..c8e1b8859 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -813,7 +813,7 @@ sub create_logo_window() { sub init_sizes() { ($::rootheight, $::rootwidth) = (480, 640); ($::rootheight, $::rootwidth) = my_gtk::gtkroot()->get_size; - ($::rootheight, $::rootwidth) = (min(768, $::rootheight), min(1024, $::rootwidth)); + #- ($::rootheight, $::rootwidth) = (min(768, $::rootheight), min(1024, $::rootwidth)); ($::stepswidth, $::stepsheight) = (140, $::rootheight); ($::logowidth, $::logoheight) = ($::rootwidth - $::stepswidth, 40); ($::helpwidth, $::helpheight) = ($::rootwidth - $::stepswidth, 100); diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm index 9462e03a1..39744ab75 100644 --- a/perl-install/keyboard.pm +++ b/perl-install/keyboard.pm @@ -97,7 +97,7 @@ arch() =~ /^sparc/ ? ( "ru" => [ __("Russian"), "sunt5-ru", "ru" ], "uk" => [ __("UK keyboard"), "sunt5-uk", "gb" ], "us" => [ __("US keyboard"), "sunkeymap", "us" ], -) : (), +) : ( arch() =~ /^ppc/ ? ( "us" => [ __("US keyboard"), "mac-us-ext", "us" ], "de_nodeadkeys" => [ __("German"), "mac-de-latin1-nodeadkeys", "de(nodeadkeys)" ], @@ -158,7 +158,7 @@ arch() =~ /^ppc/ ? ( "us" => [ __("US keyboard"), "us", "us" ], "us_intl" => [ __("US keyboard (international)"), "us-latin1", "us_intl" ], "yu" => [ __("Yugoslavian (latin layout)"), "sr", "yu" ], -), +)), ); @@ -179,22 +179,23 @@ sub text2keyboard { } sub loadkeys_files { - my $p = "/usr/lib/kbd/keymaps/i386/*"; + my $archkbd = arch() =~ /^sparc/ ? "sun" : arch() =~ /^i\d/ ? "i386" : arch(); + my $p = "/usr/lib/kbd/keymaps/$archkbd"; my $post = ".kmap.gz"; my %trans = ("cz-latin2" => "cz-lat2"); my (@l, %l); foreach (values %keyboards) { local $_ = $trans{$_->[1]} || $_->[1]; - my ($l) = glob_("$p/$_$post"); - $l or /(..)/ and ($l) = glob_("$p/$1$post"); + my ($l) = grep { -e $_ } ("$p/$_$post"); + $l or /(..)/ and ($l) = grep { -e $_ } ("$p/$1$post"); print STDERR "unknown $_\n" if $_[0] && !$l; $l or next; push @l, $l; foreach (`zgrep include $l | grep "^include"`) { /include\s+"(.*)"/ or die "bad line $_"; - @l{glob_("$p/$1.inc.gz")} = (); + @l{grep { -e $_ } ("$p/$1.inc.gz")} = (); } } - @l, keys %l, map { glob_("$p/$_.inc.gz") } qw(compose euro windowkeys linux-keys-bare); + @l, keys %l, grep { -e $_ } map { "$p/$_.inc.gz" } qw(compose euro windowkeys linux-keys-bare); } sub lang2keyboard($) { diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm index b3719cf81..e941a1529 100644 --- a/perl-install/partition_table.pm +++ b/perl-install/partition_table.pm @@ -358,7 +358,9 @@ sub read_one($$) { my ($hd, $sector) = @_; my ($pt, $info); - foreach ('dos', 'bsd', 'sun', 'mac', 'unknown') { + #- SUN bioses may blank disk or refuse to load it if the partition is unknown. + my @parttype = arch() =~ /^sparc/ ? ('sun', 'unknown') : ('dos', 'bsd', 'sun', 'mac', 'unknown'); + foreach (@parttype) { /unknown/ and die "unknown partition table format"; eval { bless $hd, "partition_table_$_"; @@ -516,6 +518,8 @@ sub add_primary($$) { } sub add_extended { + arch() =~ /^sparc/ and die _("Extended partition not supported on this platform"); + my ($hd, $part, $extended_type) = @_; $extended_type =~ s/Extended_?//; @@ -576,7 +580,8 @@ sub add($$;$$) { my $e = $hd->{primary}{extended}; - if ($primaryOrExtended eq 'Primary' || + if (arch() =~ /^sparc/ || + $primaryOrExtended eq 'Primary' || $primaryOrExtended !~ /Extended/ && is_empty_array_ref($hd->{primary}{normal})) { eval { add_primary($hd, $part) }; return unless $@; diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index e03dcc241..8db9231a9 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -113,10 +113,11 @@ my %ignoreBadPkg = ( #- following flags : selected, force, installed, base, skip. #- size and deps are grouped to save memory too and make a much #- simpler and faster depslist reader, this gets (sizeDeps). -sub packageHeaderFile { my ($pkg) = @_; $pkg->{file} } -sub packageName { my ($pkg) = @_; $pkg->{file} =~ /(.*)-[^-]+-[^-]+/ ? $1 : die "invalid file `$pkg->{file}'" } -sub packageVersion { my ($pkg) = @_; $pkg->{file} =~ /.*-([^-]+)-[^-]+/ ? $1 : die "invalid file `$pkg->{file}'" } -sub packageRelease { my ($pkg) = @_; $pkg->{file} =~ /.*-[^-]+-([^-]+)/ ? $1 : die "invalid file `$pkg->{file}'" } +sub packageHeaderFile { my ($pkg) = @_; $pkg->{file} } +sub packageName { my ($pkg) = @_; $pkg->{file} =~ /([^\(]*)(?:\([^\)]*\))?-[^-]+-[^-]+/ ? $1 : die "invalid file `$pkg->{file}'" } +sub packageSpecificArch { my ($pkg) = @_; $pkg->{file} =~ /[^\(]*(?:\(([^\)])*\))?-[^-]+-[^-]+/ ? $1 : die "invalid file `$pkg->{file}'" } +sub packageVersion { my ($pkg) = @_; $pkg->{file} =~ /.*-([^-]+)-[^-]+/ ? $1 : die "invalid file `$pkg->{file}'" } +sub packageRelease { my ($pkg) = @_; $pkg->{file} =~ /.*-[^-]+-([^-]+)/ ? $1 : die "invalid file `$pkg->{file}'" } sub packageSize { my ($pkg) = @_; to_int($pkg->{sizeDeps}) } sub packageDepsId { my ($pkg) = @_; split ' ', ($pkg->{sizeDeps} =~ /^\d*\s*(.*)/)[0] } @@ -143,7 +144,8 @@ sub packageProvides { my ($pkg) = @_; @{$pkg->{provides} || []} } sub packageFile { my ($pkg) = @_; $pkg->{header} or die "packageFile: missing header"; - $pkg->{file} . "." . c::headerGetEntry($pkg->{header}, 'arch') . ".rpm"; + $pkg->{file} =~ /([^\(]*)(?:\([^\)]*\))?(-[^-]+-[^-]+)/; + "$1$2." . c::headerGetEntry($pkg->{header}, 'arch') . ".rpm"; } sub packageId { @@ -418,10 +420,25 @@ sub psUsingHdlist { flags => 0, #- flags medium => $m, }; - if ($packages->[0]{packageName($pkg)}) { - log::l("ignoring package $1 already present in distribution"); + my $specific_arch = packageSpecificArch($pkg); + if (!$specific_arch || compat_arch($specific_arch)) { + my $old_pkg = $packages->[0]{packageName($pkg)}; + if ($old_pkg) { + if (packageVersion($pkg) eq packageVersion($old_pkg) && packageRelease($pkg) eq packageRelease($old_pkg)) { + if (better_arch($specific_arch, packageSpecificArch($old_pkg))) { + log::l("replacing old package with package $1 with better arch"); + $packages->[0]{packageName($pkg)} = $pkg; + } else { + log::l("keeping old package against package $1 with worse arch"); + } + } else { + log::l("ignoring package $1 already present in distribution with different version or release"); + } + } else { + $packages->[0]{packageName($pkg)} = $pkg; + } } else { - $packages->[0]{packageName($pkg)} = $pkg; + log::l("ignoring package $1 with incompatible arch"); } } else { die "bad hdlist file: $newf"; diff --git a/perl-install/printer.pm b/perl-install/printer.pm index 0332b85b6..c720e8d13 100644 --- a/perl-install/printer.pm +++ b/perl-install/printer.pm @@ -418,6 +418,7 @@ sub create_spool_dir($) { sub create_config_file($$%) { my ($inputfile, $outputfile, %toreplace) = @_; template2file("$prefix/$inputfile", "$prefix/$outputfile", %toreplace); + eval { commands::chown_("root.lp", "$prefix/$outputfile") }; } @@ -429,7 +430,8 @@ sub copy_master_filter($) { my $complete_path = "$prefix/$queue_path/filter"; my $master_filter = "$prefix/$PRINTER_FILTER_DIR/master-filter"; - eval { commands::cp('-f', $master_filter, $complete_path) }; #- -f for update. + eval { commands::cp('-f', $master_filter, $complete_path); + commands::cp("root.lp", $complete_path); }; #- -f for update. $@ and die "Can't copy $master_filter to $complete_path $!"; } @@ -641,13 +643,13 @@ sub configure_queue($) { print F "user=$entry->{NCPUSER}\n"; print F "password=$entry->{NCPPASSWD}\n"; } + eval { chmod 0640, "$prefix$queue_path/.config"; commands::chown_("root.lp", "$prefix$queue_path/.config") }; copy_master_filter($queue_path); #-now the printcap file, note this one contains all the printer (use configured for that). local *PRINTCAP; open PRINTCAP, ">$prefix/etc/printcap" or die "Can't open printcap file $!"; - print PRINTCAP $intro_printcap_test; foreach (values %{$entry->{configured}}) { $_->{DBENTRY} = $thedb_gsdriver{$_->{GSDRIVER}}{ENTRY} unless defined $_->{DBENTRY}; @@ -686,6 +688,7 @@ sub configure_queue($) { print PRINTCAP "\t:if=$_->{IF}:\n"; print PRINTCAP "\n"; } + eval { commands::chown_("root.lp", "$prefix/etc/printcap") }; my $useUSB = 0; foreach (values %{$entry->{configured}}) { diff --git a/perl-install/share/list.sparc b/perl-install/share/list.sparc index 442862710..efe38ea7a 100644 --- a/perl-install/share/list.sparc +++ b/perl-install/share/list.sparc @@ -76,6 +76,6 @@ /usr/lib/perl5/site_perl/5.6.0/sparc-linux/auto/Gtk/Gtk.bs /usr/lib/perl5/site_perl/5.6.0/sparc-linux/auto/Gtk/Gtk.so /usr/lib/rpm/rpmrc -/usr/X11R6/bin/XF86_Xsun24 +/usr/X11R6/bin/Xsun24 /usr/X11R6/bin/XF86_Mach64 /usr/X11R6/bin/xmodmap -- cgit v1.2.1