transfugdrake - Windows User Migration Wizard

diff options

Diffstat (limited to 'po')

-rw-r--r--

1 files changed, 6 insertions, 1 deletions

#!/usr/bin/perl my ($mode, $dir, $reject_dir, $lang) = @ARGV; $mode =~ s/^--(rebuild|clean)$/$1/ or die "mode should be --rebuild or --clean\n"; -e "$dir/Mandrake/base/hdlists" && -d $reject_dir or die "usage: oem-prepare <--rebuild|--clean> <top_dir> <reject_dir> <lang>\n"; #- detect language used and default options. open F, "$dir/VERSION" or die "no installation found on $dir"; while (<F>) { /[\s-]fr/ and $lang = 'fr'; /\[lang[=:]([^]]*)\]/ and $lang = $1; /[\[\-]server[\]\-]/ and $options{server} = ''; } close F; my ($flang, $charset); #- default language fall to english ? foreach ($lang || 'en') { /fr/ and ($lang, $flang, $charset) = ('fr', 'fr_FR@euro', 'iso-8859-15'); /en/ and ($lang, $flang, $charset) = ('en', 'en_US', 'iso-8859-1'); /de/ and ($lang, $flang, $charset) = ('de', 'de_DE@euro', 'iso-8859-15'); /it/ and ($lang, $flang, $charset) = ('it', 'it_IT@euro', 'iso-8859-15'); /es/ and ($lang, $flang, $charset) = ('es', 'es_ES@euro', 'iso-8859-15'); } print "Found lang $lang\n"; foreach (keys %options) { print "Using option [$_" . ($options{$_} && "=$options{$_}") . "]\n"; } my $packages = select_packages($dir, $lang); my @media; open F, "$dir/Mandrake/base/hdlists"; foreach (<F>) { chomp; s/\s*#.*$//; /^\s*$/ and next; m/^\s*(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die "invalid hdlist description \"$_\" in hdlists file"; push @media, { hdlist => $1, rpmsdir => $2, descr => $3 }; } close F; #- keep in mind all the rpm files available (according to hdlists). my (%rpms, %files); require packdrake; foreach my $medium (@media) { my $packer = new packdrake("$dir/Mandrake/base/$medium->{hdlist}"); foreach (@{$packer->{files}}) { $packer->{data}{$_}[0] eq 'f' or next; my ($fullname, $file) = /([^:]*):(.*)/ ? ($1, "$2.rpm") : ($_, "$_.rpm"); $files{$fullname} = $file; $rpms{$file} = $medium->{rpmsdir}; -e "$dir/$medium->{rpmsdir}/$file" and next; #- already exist in the right directory. if (-e "$reject_dir/$file") { $mode eq 'rebuild' and system "mv", "-f", "$reject_dir/$file", "$dir/$medium->{rpmsdir}/"; next; } print STDERR "unable to find package $file listed in medium \"$medium->{descr}\"\n"; } } if ($mode eq 'clean') { #- copy and install from each cd image. foreach my $medium (@media) { print "Examining packages from medium labeled \"$medium->{descr}\"\n"; foreach my $pkg (@{$packages->{depslist}}) { $pkg->{closure} && !$pkg->{selected} or next; my $file = "$dir/$medium->{rpmsdir}/" . $files{rpm_fullname($pkg)}; if (-e $file) { delete $rpms{$files{rpm_fullname($pkg)}} or next; print " copying $file\n"; delete $pkg->{closure}; } } if (my $pkg = pkgs::packageByName($packages, 'glibc')) { #- HACK FOR GLIBC if ($pkg->{selected}) { my $file = "$dir/$medium->{rpmsdir}/" . $files{rpm_fullname($pkg)}; if (-e $file) { delete $rpms{$files{rpm_fullname($pkg)}} or next; print " installing $file\n"; delete $pkg->{selected}; } } } else { die "no glibc package found"; } foreach my $pkg (@{$packages->{depslist}}) { $pkg->{selected} or next; my $file = "$dir/$medium->{rpmsdir}/" . $files{rpm_fullname($pkg)}; if (-e $file) { delete $rpms{$files{rpm_fullname($pkg)}} or next; print " installing $file\n"; delete $pkg->{selected}; } } scalar(grep { $_->{selected} || $_->{closure} } @{$packages->{depslist}}) == 0 and last; } #- copy files. #- at this point, everything left in %rpms has to be moved to $reject_dir. foreach (keys %rpms) { -e "$reject_dir/$_" and next; #- already cleaned. -e "$dir/$rpms{$_}/$_" or print STDERR "file \"$_\" should be in [$dir/$rpms{$_}]\n", next; system "mv", "-f", "$dir/$rpms{$_}/$_", $reject_dir; } } #- provide package fullname that have to be installed and copied. sub select_packages { my ($dir, $lang) = @_; my $o = { packages => read_depslist("$dir/Mandrake/base/depslist.ordered") }; #- act as DrakX will do to select packages. pkgs::read_rpmsrate($o->{packages}, install_any::getFile("Mandrake/base/rpmsrate") || die "unable to read rpmsrate"); ($o->{compssUsers}, $o->{compssUsersSorted}, $o->{compssUsersIcons}, $o->{compssUsersDescr}) = pkgs::readCompssUsers($o->{packages}, $o->{meta_class}); eval { install_any::getFile("XXX") }; #- close out any still opened filehandle.. pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, 'basesystem') || die "no basesystem package found"); #- by default, choose: $o->{compssUsersChoice}{$_} = 1 foreach 'GNOME', 'KDE', 'CONFIG', 'X'; $o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}{flags}} } 'Workstation|Office Workstation', 'Workstation|Internet station'; if (exists $options{server}) { foreach (qw(KDE ACCESSIBILITY PUBLISHING CUPS EDITORS TEXT_TOOLS COMMUNICATIONS TERMINALS NETWORKING_FILE_TRANSFER NETWORKING_OTHER NETWORKING_FILE_TRANSFER_SERVER NETWORKING_FIREWALLING_SERVER NETWORKING_LDAP_SERVER NETWORKING_MAIL_SERVER NETWORKING_OTHER_SERVER NETWORKING_REMOTE_ACCESS NETWORKING_REMOTE_ACCESS_SERVER NETWORKING_DNS NETWORKING_DNS_SERVER NETWORKING_FILE NETWORKING_FILE_SERVER NETWORKING_WWW NETWORKING_WWW_SERVER ARCHIVING DEVELOPMENT MONITORING FILE_TOOLS CONFIG BOOKS SYSTEM X DOCS)) { $o->{compssUsersChoice}{$_} = 1; } #- additional packages to be selected for server, databases with MySQL (avoid rpmsrate modifications). foreach (qw(MySQL-client MySQL-shared MySQL perl-Mysql)) { my $pkg = pkgs::packageByName($o->{packages}, $_); $pkg and pkgs::selectPackage($o->{packages}, $pkg); } } else { $o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}} } @{$o->{compssUsersSorted}}; $o->{compssUsersChoice}{$_} = 1 foreach qw(SYSTEM X DOCS); @{$o->{compssUsersChoice}}{grep { /SERVER|DATABASES/ } keys %{$o->{compssUsersChoice}}} = (); } my $lang_pkg = $lang && pkgs::packageByName($o->{packages}, "locales-$lang"); if ($lang_pkg) { pkgs::selectPackage($o->{packages}, $lang_pkg); $o->{compssUsersChoice}{qq(LOCALES"$lang")} = 1; $o->{compssUsersChoice}{qq(LOCALES"$flang")} = 1; $o->{compssUsersChoice}{qq(CHARSET"$charset")} = 1; } pkgs::setSelectedFromCompssList($o->{packages}, $o->{compssUsersChoice}, 4, 0); #- save selected, but keep selected property. foreach my $pkg (@{$o->{packages}{depslist}}) { $pkg->{selected} and $pkg->{save_selected} = $pkg->{selected}; } #- extend selection to closure now, make all selected as closure and restore selected after. $o->{compssUsersChoice}{$_} = 1 foreach qw(BURNER DVD PCMCIA BIGMEM SMP 3D TV SCANNER PHOTO SOUND); pkgs::setSelectedFromCompssList($o->{packages}, $o->{compssUsersChoice}, 4, 0); $o->{compssUsersChoice}{$_} = 0 foreach qw(BURNER DVD PCMCIA BIGMEM SMP 3D TV SCANNER PHOTO SOUND); #- INSTALL class need to be copied as closure (unless installed after). #- but we have to remove kernel22 and kernel22-smp now obsolete for oem. foreach (@{$o->{packages}{needToCopy}}) { /^(kernel22.*|raidtools|lvm|reiserfsprogs|xfsprogs|jfsprogs|XFree86-(Mach8|Mach32|Mono|W32|3DLabs|P9000|8514|VGA16|I128|AGX))$/ and next; my $pkg = pkgs::packageByName($o->{packages}, $_); pkgs::selectPackage($o->{packages}, $pkg); } #- first select package that have to go to closure according to their names. foreach my $pkg (@{$o->{packages}{depslist}}) { $pkg->{name} =~ /kernel-(\d|smp|enterprise)/ and pkgs::selectPackage($o->{packages}, $pkg); $pkg->{name} =~ /NVIDIA/ and pkgs::selectPackage($o->{packages}, $pkg); } foreach my $pkg (@{$o->{packages}{depslist}}) { delete $pkg->{selected} && !$pkg->{save_selected} and $pkg->{closure} = 1; $pkg->{save_selected} and $pkg->{selected} = $pkg->{save_selected}; } #- package that have to selected here as a bonus for oem install. foreach (qw(cups cups-drivers a2ps drakprofile draksync numlock icewm-light Mesa Mesa-demos alsa alsa-utils curl glibc vim-minimal kernel gcc-cpp ), exists $options{server} ? qw(openldap-migration openldap-clients pam_ldap) : ()) { my $pkg = pkgs::packageByName($o->{packages}, $_); $pkg and pkgs::selectPackage($o->{packages}, $pkg); } #- special packages that are to be move to closure always ... foreach (qw(nfs-utils-client numlock usbd hotplug alsa alsa-utils Aurora Aurora-Monitor-NewStyle-Categorizing-WsLib bootsplash)) { my $pkg = pkgs::packageByName($o->{packages}, $_); if ($pkg) { pkgs::selectPackage($o->{packages}, $pkg); $pkg->{closure} = 1; delete $pkg->{selected}; } } #- special packages that are to be removed always... BEWARE THIS IS A HACK !!! # foreach (qw(gmc gcc3.0 gcc3.0-c++ gcc3.0-cpp libstdc++3.0 libstdc++3.0-devel)) { # my $pkg = pkgs::packageByName($o->{packages}, $_); # if ($pkg) { # delete $pkg->{closure}; # delete $pkg->{selected}; # } # } $o->{packages}; } sub chop_version { ($_[0] =~ /^([^:\s]*)-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*(?::\S*)?/)[0] || die "unable to parse $_[0]"; } sub rpm_fullname { ($_[0]{name} =~ /^([^:\s]*-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*)(?::\S*)?/)[0] || die "unable to parse $_[0]"; } sub read_depslist { my ($file) = @_; my $packages = { depslist => [], names => {} }; #- read depslist.oredered file. my $id = 0; open F, "$file" or die "unable to open ordered dependencies list file"; while (<F>) { my ($name, $size, @deps) = split; push @{$packages->{depslist}}, { id => $id++, name => $name, size => $size, deps => \@deps }; } close F; foreach (@{$packages->{depslist}}) { $packages->{names}{chop_version($_->{name})} = $_; } print "read " . scalar(@{$packages->{depslist}}) . " package dependancies\n"; $packages; } #- compability method for the below ones, wrap DrakX code extracted. package log; sub l {} package detect_devices; sub matching_desc { 0 } package install_any; sub getFile { open FILE, "$dir/$_[0]" or return; \*FILE } package pkgs; sub if_ { my $b = shift; $b or return (); wantarray ? @_ : $_[0] } sub formatXiB { $_[0] } #- NOP sub packageName { ::chop_version($_[0]{name}) } sub packageFlagSelected { $_[0]{selected} } sub packageSize { $_[0]{size} } sub packageDepsId { @{$_[0]{deps}} } sub packageRate { $_[0]{values}[0] } sub packageRateRFlags { @{$_[0]{values}} } sub packageSetRateRFlags { my ($pkg, @rate_rflags) = @_; $pkg->{values} = [ @rate_rflags ]; } sub packageByName { my ($packages, $name) = @_; $packages->{names}{$name}; } sub packageById { my ($packages, $id) = @_; $packages->{depslist}[$id]; } sub selectedSize { my ($packages) = @_; my $size = 0; foreach (@{$packages->{depslist}}) { $_->{selected} and $size += $_->{size}; } $size; } my @preferred = qw(perl-GTK postfix gcc gcc-cpp gcc-c++ proftpd ghostscript-X vim-minimal kernel db1 db2 ispell-en Bastille-Curses-module nautilus libxpm4); sub selectPackage { my ($packages, $pkg, $base, $otherOnly, $check_recursion) = @_; #- avoid infinite recursion (mainly against badly generated depslist.ordered). $check_recursion ||= {}; exists $check_recursion->{$pkg->{name}} and return; $check_recursion->{$pkg->{name}} = undef; #- make sure base package are set even if already selected. $base and $pkg->{base} = 1; #- select package and dependancies, otherOnly may be a reference #- to a hash to indicate package that will strictly be selected #- when value is true, may be selected when value is false (this #- is only used for unselection, not selection) unless ($pkg->{selected}) { foreach (@{$pkg->{deps}}) { my $preferred; if (/\|/) { #- choice deps should be reselected recursively as no #- closure on them is computed, this code is exactly the #- same as pixel's one. my %preferred; @preferred{@preferred} = (); foreach (split '\|') { my $dep = $packages->{depslist}[$_] or next; $preferred ||= $dep; $dep->{selected} and $preferred = $dep, last; exists $preferred{::chop_version($dep->{name})} and $preferred = $dep; } selectPackage($packages, $preferred, $base, $otherOnly, $check_recursion) if $preferred; } else { #- deps have been closed except for choices, so no need to #- recursively apply selection, expand base on it. my $dep = $packages->{depslist}[$_]; $base and $dep->{base} = 1; $otherOnly and !$dep->{selected} and $otherOnly->{::chop_version($dep->{name})} = 1; $otherOnly or $dep->{selected} += 1; } } } $otherOnly and !$pkg->{selected} and $otherOnly->{::chop_version($pkg->{name})} = 1; $otherOnly or $pkg->{selected} += 1; 1; } #- this code is extracted from DrakX and SHOULD NOT BE MODIFIED, wrapper method exists above to provide a good choice. sub read_rpmsrate { my ($packages, $f) = @_; my $line_nb = 0; my $fatal_error; my (@l); while (<$f>) { $line_nb++; /\t/ and die "tabulations not allowed at line $line_nb\n"; s/#.*//; # comments my ($indent, $data) = /(\s*)(.*)/; next if !$data; # skip empty lines @l = grep { $_->[0] < length $indent } @l; my @m = @l ? @{$l[$#l][1]} : (); my ($t, $flag, @l2); while ($data =~ /^(( [1-5] | (?: (?: !\s*)? [0-9A-Z_]+(?:".*?")?) (?: \s*\|\|\s* (?: !\s*)? [0-9A-Z_]+(?:".*?")?)* ) (?:\s+|$) )(.*)/x) { #@")) { ($t, $flag, $data) = ($1,$2,$3); while ($flag =~ s,^\s*(("[^"]*"|[^"\s]*)*)\s+,$1,) {} my $ok = 0; $flag = join('||', grep { if (my ($inv, $p) = /^(!)?HW"(.*)"/) { ($inv xor detect_devices::matching_desc($p)) and $ok = 1; 0; } else { 1; } } split '\|\|', $flag); push @m, $ok ? 'TRUE' : $flag || 'FALSE'; push @l2, [ length $indent, [ @m ] ]; $indent .= $t; } if ($data) { # has packages on same line my ($rate) = grep { /^\d$/ } @m or die sprintf qq(missing rate for "%s" at line %d (flags are %s)\n), $data, $line_nb, join('&&', @m); foreach (split ' ', $data) { if ($packages) { my $p = packageByName($packages, $_) or next; my @m2 = map { if_($_ && packageName($_) =~ /locales-(.*)/, qq(LOCALES"$1")) } map { packageById($packages, $_) } packageDepsId($p); my @m3 = ((grep { !/^\d$/ } @m), @m2); if (@m3 >= 1 && $m3[0] eq 'INSTALL' || @m3 >=2 && $m3[1] eq 'INSTALL') { push @{$packages->{needToCopy} ||= []}, $_; next; #- don't need to put INSTALL flag for a package. } if (packageRate($p)) { my ($rate2, @m4) = packageRateRFlags($p); if (@m3 > 1 || @m4 > 1) { log::l("can't handle complicate flags for packages appearing twice ($_)"); $fatal_error++; } log::l("package $_ appearing twice with different rates ($rate != $rate2)") if $rate != $rate2; packageSetRateRFlags($p, $rate, "$m3[0]||$m4[0]"); } else { packageSetRateRFlags($p, $rate, @m3); } } else { print "$_ = ", join(" && ", @m), "\n"; } } push @l, @l2; } else { push @l, [ $l2[0][0], $l2[$#l2][1] ]; } } $fatal_error and die "$fatal_error fatal errors in rpmsrate"; } sub readCompssUsers { my ($packages, $meta_class) = @_; my (%compssUsers, %compssUsersIcons, , %compssUsersDescr, @sorted, $l); my (%compss); my $file = 'Mandrake/base/compssUsers'; my $f = $meta_class && install_any::getFile("$file.$meta_class") || install_any::getFile($file) or die "can't find $file"; local $_; while (<$f>) { /^\s*$/ || /^#/ and next; s/#.*//; if (/^(\S.*)/) { my ($icon, $descr); /^(.*?)\s*\[icon=(.*?)\](.*)/ and $_ = "$1$3", $icon = $2; /^(.*?)\s*\[descr=(.*?)\](.*)/ and $_ = "$1$3", $descr = $2; $compssUsersIcons{$_} = $icon; $compssUsersDescr{$_} = $descr; push @sorted, $_; $compssUsers{$_} = $l = []; } elsif (/^\s+(.*?)\s*$/) { push @$l, $1; } } \%compssUsers, \@sorted, \%compssUsersIcons, \%compssUsersDescr; } sub setSelectedFromCompssList { my ($packages, $compssUsersChoice, $min_level, $max_size, $otherOnly) = @_; $compssUsersChoice->{TRUE} = 1; #- ensure TRUE is set my $nb = selectedSize($packages); foreach my $p (sort { packageRate($b) <=> packageRate($a) } values %{$packages->{names}}) { my ($rate, @flags) = packageRateRFlags($p); next if !$rate || $rate < $min_level || grep { !grep { /^!(.*)/ ? !$compssUsersChoice->{$1} : $compssUsersChoice->{$_} } split('\|\|') } @flags; #- determine the packages that will be selected when #- selecting $p. the packages are not selected. my %newSelection; selectPackage($packages, $p, 0, \%newSelection); #- this enable an incremental total size. my $old_nb = $nb; foreach (grep { $newSelection{$_} } keys %newSelection) { $nb += packageSize($packages->{names}{$_}); } if ($max_size && $nb > $max_size) { $nb = $old_nb; $min_level = packageRate($p); last; } #- at this point the package can safely be selected. if ($otherOnly) { selectPackage($packages, $p, 0, $otherOnly); } else { selectPackage($packages, $p); } } unless ($otherOnly) { log::l("setSelectedFromCompssList: reached size ", formatXiB($nb), ", up to indice $min_level (less than ", formatXiB($max_size), ")"); log::l("setSelectedFromCompssList: ", join(" ", sort map { packageName($_) } grep { packageFlagSelected($_) } @{$packages->{depslist}})); } $min_level; }


context:
space:
mode: