*** empty log message ***

11 files changed, 86 insertions, 27 deletions

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  <fpons@mandrakesoft.com>
+
+	* *.pm: sparc and sparc64 update, a long to do again.
+
 2000-05-09  Pixel  <pixel@mandrakesoft.com>
 
 	* 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