diff options
| -rw-r--r-- | lib/MGA/DrakISO/BuildMedia.pm | 374 |
1 files changed, 166 insertions, 208 deletions
diff --git a/lib/MGA/DrakISO/BuildMedia.pm b/lib/MGA/DrakISO/BuildMedia.pm index c1472c8..50849b8 100644 --- a/lib/MGA/DrakISO/BuildMedia.pm +++ b/lib/MGA/DrakISO/BuildMedia.pm @@ -28,6 +28,8 @@ use strict; use MDK::Common; use common; use URPM; +use urpm; +use urpm::media; use MGA::DrakISO::ClassicBuild; use MGA::DrakISO::Utils; @@ -36,34 +38,30 @@ use MGA::DrakISO::Utils; # Global Variables ############################################################################### -# This hash contains the currently enabled media in our urpmi chroot. -# The hash key is the media name and the hash value is the media URL. -my %media; +# This object is used to access the urpmi database in our urpmi chroot. +my $urpm; -# This hash contains the currently selected packages. The hash key is -# the package name and the hash value is the package class. A class of -# 1 indicates a package that was explicitly selected, and a class of 2 -# indicates a package that was added as a dependency. -my %package_class; +# This hash contains all the packages available in the currently enabled media. +# The hash key is the package name and the hash value is a hash containing the +# following fields: +# +# object the URPM::Package object for the newest version/release +# of that package +# +# class undefined if the package is not selected +# set to 1 if the package was explicity selected +# set to 2 if the package was added as a dependency +# +my %package; -# This hash contains the selected rpmsrate groups. The hash key is the -# group name and the hash value is the threshold for selecting packages -# in that group. +# This hash contains the selected rpmsrate categories. The hash key is the +# category name and the hash value is the threshold for selecting packages +# in that category. my %group_threshold; # This array contains the list of packages the user has asked to be excluded. # Each array element is the name of a package. -my @excluded_packages; - -# This hash contains the selected packages known to conflict with other -# selected packages. It is optionally seeded from a list provided by the -# user, and will be added to when we run a test installation and detect -# conflicts. The hash key is the package name, and the hash value is just -# set to 1. -# -# NOTE: This is only required because 'urpmq --requires-recursive' returns -# an incomplete list of dependencies when there are package conflicts. -my %known_conflicts; +my @excluded; ############################################################################### # Main Code @@ -72,14 +70,12 @@ my %known_conflicts; sub prepare_media { my ($build) = @_; - # Create a working directory to hold the output from urpmq/urpmi runs - # and any other log files we generate. Nothing in this directory is - # needed after we exit this function. + # Create a working directory to hold any temporary files we generate. + # Nothing in this directory is needed after we exit this function. mkdir_p($build->get_builddir('tmp')); prepare_urpmi_media($build); - - get_known_conflicts($build); + get_available_packages($build); include_groups ($build, $build->{group_include_lists}); exclude_packages($build, $build->{group_exclude_lists}); @@ -91,9 +87,8 @@ sub prepare_media { exclude_packages($build, $build->{package_exclude_lists}); update_dependencies($build); - handle_conflicts($build); - build_installer_media($build); + check_installer_media($build); my $arch = $build->{settings}{arch}; my $version = $build->{settings}{version}; @@ -103,6 +98,10 @@ sub prepare_media { create_product_id($build, $arch_dir . '/product.id'); create_index($build, $arch_dir . '/pkg-' . $version . '-' . $tag . '.idx'); + + undef $urpm; + undef %package; + undef @excluded; } ############################################################################### @@ -112,6 +111,10 @@ sub prepare_media { sub prepare_urpmi_media { my ($build) = @_; + # This hash contains the enabled media in our urpmi chroot. The hash + # key is the media name and the hash value is the media URL. + my %media; + # Get a list of the currently configured media in our urpmi root. my $list_file = $build->get_builddir('tmp') . '/media_url.lst'; run_urpm($build, "urpmq", "--list-url > $list_file"); @@ -154,11 +157,30 @@ sub prepare_urpmi_media { next if $media_valid{$name}; run_urpm($build, "urpmi.removemedia", $name); } - - # Get a list of the available packages, for use later. - run_urpm($build, "urpmq", '--list > ' . $build->get_builddir('tmp') . '/pkg-available.lst'); } +sub get_available_packages { + my ($build) = @_; + + $urpm = urpm->new; + + urpm::set_files($urpm, $build->get_system_root); + urpm::get_global_options($urpm); + + $urpm->{info} = sub { }; + $urpm->{log} = sub { }; + + urpm::media::configure($urpm); + + $urpm->traverse(sub { + my ($pkg) = @_; + my $name = $pkg->name(); + if (!defined $package{$name} || $pkg->compare_pkg($package{$name}{object}) > 0) { + $package{$name}{object} = $pkg; + } + }); +} + ############################################################################### # Package Group Selection ############################################################################### @@ -178,10 +200,11 @@ sub include_groups { my ($name, $threshold) = split(' ', $entry); next if !$name; # skip pure comment lines if ($name =~ /^task-/) { - $package_class{$name} = 1; + $package{$name} or die "ERROR: $name is not available in the urpmi media\n"; + $package{$name}{class} = 1; } else { $threshold >= 1 && $threshold <= 6 - or die "Invalid threshold for $name on line $line_number of '$file'\n"; + or die "ERROR: invalid threshold for $name on line $line_number of '$file'\n"; $group_threshold{$name} = $threshold; } } @@ -293,11 +316,15 @@ sub add_rated_packages { # Skip any packages that don't match the user's requirements. next if !any { defined $group_threshold{$_} && $rating >= $group_threshold{$_} } @flags; - # Add the package to our selected package list, setting the - # package class to 1 to indicate this is an explicitly selected - # package. - foreach my $pkg (split ' ', $remaining) { - $package_class{$pkg} = 1; + # For each package, set the package class to 1 to indicate it is + # an explicitly selected package. + foreach my $name (split ' ', $remaining) { + if (defined $package{$name}) { + $package{$name}{class} = 1; + } else { + # tolerate errors in the rpmsrate file + print "INFO <rpmsrate>: $name is not available in the urpmi media\n"; + } } } } @@ -337,139 +364,49 @@ sub update_dependencies { print "Calculating dependencies\n" if $::verbose; # Remove any existing dependencies. - my @dependencies = grep { $package_class{$_} == 2 } keys %package_class; - delete @package_class{@dependencies}; + my @dependencies = grep { $package{$_}{class} == 2 } keys %package; + delete $package{$_}{class} foreach @dependencies; # Calculate the dependencies and update the package list. - my @packages = keys %package_class; - my $skip_list = join(',', keys %known_conflicts, @excluded_packages); - add_dependencies_to_selected_packages($build, \@packages, $skip_list); -} - -sub add_dependencies_to_selected_packages { - my ($build, $packages, $o_skip_list) = @_; - - # Use urpmq to generate a new list of dependencies. Note that this list - # will include the original package list. - my $options = '--requires-recursive --no-recommends'; - if ($o_skip_list) { - $options .= ' --skip ' . $o_skip_list; - } - my $list_file = $build->get_builddir('tmp') . '/packages.lst'; - run_urpm($build, 'urpmq', join(' ', $options, @$packages, '>', $list_file)); - - # Add the new dependencies to our selected package list, setting the - # package class to 2 to indicate these are implicitly selected packages. - update_package_selection($build, $list_file, \&add_to_selected_packages, 2); - report_package_count(); -} - -############################################################################### -# Package Conflict Handling -############################################################################### - -sub get_known_conflicts { - my ($build) = @_; - - my $arch = $build->{settings}{arch}; - - my $file = $build->{known_conflicts}; - -f $file or return; - - print "Reading known conflicts from $file\n" if $::verbose; - foreach my $line (cat_($file)) { - my ($data, $comment) = split('#', $line); - next if !$data; # skip pure comment lines - my ($head, $tail) = split(':', $data, 2); - if ($head && $tail) { - next if $head !~ /\s*$arch\s*/; - $data = $tail; - } - my @packages = split(' ', $data); - foreach my $pkg (@packages) { - $known_conflicts{$pkg} = 1; - } - } -} - -sub handle_conflicts { - my ($build) = @_; - - # Remove any existing dependencies. - my @dependencies = grep { $package_class{$_} == 2 } keys %package_class; - delete @package_class{@dependencies}; - - # Remove any known conflicts - my @conflicts = grep { $known_conflicts{$_} } keys %package_class; - delete @package_class{@conflicts}; - - my @packages = keys %package_class; - my $log_file = $build->get_builddir('tmp') . '/test-install.log'; - my $skip_list = join(',', keys %known_conflicts, @excluded_packages); - my $error = check_for_conflicts($build, \@packages, $log_file, $skip_list); - - return if !($error || %known_conflicts); - - if ($error) { - print "Attempting to resolve package conflicts\n" if $::verbose; - my $tries = 0; - do { - if (++$tries > 5) { - die "ERROR: there are package conflicts or unsatisfied dependencies I can't resolve.\n" - . " See $log_file for details.\n"; - } - - my $conflicts_file = $build->get_builddir('tmp') . '/conflicts.lst'; - system("grep 'conflicts\\\|unsatisfied' $log_file | awk '{ print \$1; }' | sort -u > $conflicts_file"); - - foreach my $pkg (cat_($conflicts_file)) { - chomp($pkg); - $pkg =~ s/^(\S+)-\d+(\.\d+)*-\d+\.mga\d+(\.\w+)+$/$1/; - print " $pkg\n" if $::verbose > 1; - delete $package_class{$pkg}; - $known_conflicts{$pkg} = 1; - } - @packages = keys %package_class; - $log_file = $build->get_builddir('tmp') . '/test-install-' . $tries . '.log'; - $skip_list = join(',', keys %known_conflicts, @excluded_packages); - } while check_for_conflicts($build, \@packages, $log_file, $skip_list); - print "NOTE: some package conflicts were automatically resolved.\n"; - } - - update_dependencies($build); - - my $errors = 0; - $skip_list = join(',', @excluded_packages); - foreach my $pkg (keys %known_conflicts) { - $error = check_for_conflicts($build, [ $pkg ], $log_file); - if ($error) { - print "ERROR: the $pkg package is not installable because:\n"; - print "-- messages from urpmi ----------------------------\n"; - system("cat $log_file"); - print "---------------------------------------------------\n"; - $errors++; - } else { - $package_class{$pkg} = 1; - add_dependencies_to_selected_packages($build, [ $pkg ], $skip_list); + my @search_list = grep { $package{$_}{class} == 1 } keys %package; + while (@search_list) { + foreach my $name (@search_list) { + my $pkg = $package{$name}{object}; + my $parent_name = $pkg->name(); + my @requires = $pkg->requires_nosense(); + $urpm->traverse_tag('whatprovides', \@requires, sub { + my ($pkg) = @_; + my $name = $pkg->name(); + # kernel and kmod packages embed the kernel version and release + # in the package name (and always have a version-release of 1-1) + # so we have to do a bit of fancy footwork here to ensure we + # only get the latest version of each package. Each kernel or + # kmod package has a 'latest' counterpart that just requires + # the latest version of that package. So unless we are + # satisfying the requirement of the 'latest' counterpart, + # we just change the provider name to that of the counterpart, + # which avoids pulling in any earlier versions of the package. + # Sadly the naming convention is different for kernel and for + # kmod packages, so we need to handle two variants. + if ($name =~ /^kernel-/) { + my $latest_name = $name =~ s/-\d.*-\d+\.mga\d+/-latest/r; + $name = $latest_name if $parent_name ne $latest_name; + } + if ($name =~ /-kernel-/) { + my $latest_name = $name =~ s/-\d.*-(.*)-\d+\.mga\d+/-$1-latest/r; + $name = $latest_name if $parent_name ne $latest_name; + } + return if member($name, @excluded); + $package{$name} or die "ERROR: $name is not available in the urpmi media\n"; + $package{$name}{class} = 3 if !defined $package{$name}{class}; + }); } + # Any dependencies we haven't seen before need to be checked + # for further dependencies. + @search_list = grep { $package{$_}{class} == 3 } keys %package; + $package{$_}{class} = 2 foreach @search_list; } - if ($errors) { - $::force or die "ERROR: not all conflicts or dependencies could be resolved.\n"; - print "NOTE: **** continuing due to --force option ****\n"; - print "NOTE: **** this ISO is not suitable for final release ****\n"; - } -} - -sub check_for_conflicts { - my ($build, $packages, $log_file, $o_skip_list) = @_; - - my $what = @$packages == 1 ? $$packages[0] : 'all packages'; - print "Checking for package conflicts and unsatisfied dependencies [$what]\n" if $::verbose > 1; - my $options = '-q --test --auto --no-recommends --ignoresize --no-verify-rpm'; - if ($o_skip_list) { - $options .= ' --skip ' . $o_skip_list; - } - run_urpm($build, 'urpmi', join(' ', $options, @$packages, '>', $log_file), 'not-fatal'); + report_package_count(); } ############################################################################### @@ -491,21 +428,21 @@ sub build_installer_media { print " adding RPMs\n" if $::verbose > 1; - # Use urpmq to list the full source paths to the selected RPMs. - my @packages = keys %package_class; - my $rpms_file = $build->get_builddir('tmp') . '/rpms.lst'; - run_urpm($build, 'urpmq', join(' ', '--newest --sources', @packages, '>', $rpms_file)); - - # Add them to the appropriate media directory. Note that in the - # installation media there is only a single medium for each class - # class, so we ignore the source media type. - foreach my $src_file (cat_($rpms_file)) { - chomp($src_file); - my @path_parts = split('/', $src_file); + # Find the URLs for the selected RPMs and add them to the appropriate + # media directory. Note that in the installation media there is only a + # single medium for each class, so we ignore the source media type. + my @packages = grep { defined $package{$_}{class} } keys %package; + foreach my $name (@packages) { + my $pkg = $package{$name}{object}; + my $id = $pkg->id(); + my @medium = grep { $id >= $_->{start} && $id <= $_->{end} } @{$urpm->{media}} + or die "ERROR: failed to identify the medium containing the $name package\n"; + my $src_path = $medium[0]->{url} . '/' . $pkg->filename(); + my @path_parts = split('/', $src_path); my $class = $path_parts[-3]; my $name = $path_parts[-1]; - my $dst_file = $media_dir . $class . '/' . $name; - copy_or_link($src_file, $dst_file); + my $dst_path = $media_dir . $class . '/' . $name; + copy_or_link($src_path, $dst_path); } print " generating media info\n" if $::verbose > 1; @@ -562,6 +499,25 @@ sub create_media_cfg { close $f; } +sub check_installer_media { + my ($build) = @_; + + print "Checking installer media\n" if $::verbose; + + my $arch = $build->{settings}{arch}; + my $media_dir = $build->get_builddir('files/' . $arch . '/media/'); + my $log_file = $build->get_builddir('tmp') . '/rpmcheck.log'; + system("zcat -q $media_dir/*/media_info/hdlist.cz | rpmcheck -explain -failures > $log_file") == 0 + or die "ERROR: failed to run rpmcheck\n"; + + if (system("grep -q FAILED $log_file") == 0) { + system("cat $log_file"); + $::force or die "ERROR: some package dependencies are not satisfied\n"; + print "NOTE: **** continuing due to --force option ****\n"; + print "NOTE: **** this ISO is not suitable for final release ****\n"; + } +} + ############################################################################### # Miscellaneous File Creation ############################################################################### @@ -627,37 +583,39 @@ sub run_urpm { my $urpmi_root = '--urpmi-root ' . $build->get_system_root; - # NOTE: don't try to create the command line by embedding variables in a double-quoted - # string. If $parameters is very large, it causes a buffer overrun. - my $error = system(join(' ', 'LC_ALL=C sudo', $cmd, $urpmi_root, $parameters)); + my $error = system("LC_ALL=C sudo $cmd $urpmi_root $parameters"); $error == 0 || $o_not_fatal or die "ERROR: $cmd command failed\n"; $error; } sub add_to_selected_packages { - my ($source, $pkg, $class, $o_warn) = @_; + my ($source, $name, $class, $o_warn) = @_; - if ($package_class{$pkg} == 1) { - print "INFO <$source>: $pkg is already explictly selected\n" if $o_warn; - } elsif ($package_class{$pkg} == 2) { - print "INFO <$source>: $pkg is already implictly selected\n" if $o_warn; - $package_class{$pkg} = $class; + $package{$name} or die "ERROR <$source>: $name is not available in the urpmi media\n"; + + if ($package{$name}{class} == 1) { + print "INFO <$source>: $name is already explictly selected\n" if $o_warn; + } elsif ($package{$name}{class} == 2) { + print "INFO <$source>: $name is already implictly selected\n" if $o_warn; + $package{$name}{class} = $class; } else { - print "INFO <$source>: Selecting package $pkg\n" if $::verbose > 2; - $package_class{$pkg} = $class; + print "INFO <$source>: selecting package $name\n" if $::verbose > 2; + $package{$name}{class} = $class; } } sub remove_from_selected_packages { - my ($source, $pkg, $class, $o_warn) = @_; + my ($source, $name, $class, $o_warn) = @_; + + $package{$name} or die "ERROR <$source>: $name is not available in the urpmi media\n"; - if (defined $package_class{$pkg}) { - print "INFO <$source>: Deselecting package $pkg\n" if $::verbose > 2; - delete $package_class{$pkg}; + if (defined $package{$name}{class}) { + print "INFO <$source>: deselecting package $name\n" if $::verbose > 2; + delete $package{$name}{class}; } else { - print "INFO <$source>: $pkg is not currently selected\n" if $o_warn; + print "INFO <$source>: $name is not currently selected\n" if $o_warn; } - push @excluded_packages, $pkg; + push @excluded, $name; } sub update_package_selection { @@ -676,30 +634,30 @@ sub update_package_selection { $data = $tail; } my @packages = split(' ', $data); - foreach my $pkg (@packages) { - my @alternatives = split('\|', $pkg); + foreach my $name (@packages) { + my @alternatives = split('\|', $name); if (@alternatives > 1) { foreach my $alternative (@alternatives) { $action->($file, $alternative, $class); } - } elsif ($pkg =~ /[?*]/) { - print " expanding package $pkg\n" if $::verbose > 1; - $pkg =~ s/\?/.?/g; - $pkg =~ s/\*/.*/g; - my $available_list = $build->get_builddir('tmp') . '/pkg-available.lst'; - my @candidates = split('\n', `LC_ALL=C grep '^$pkg\$' $available_list`); + } elsif ($name =~ /[?*]/) { + print " expanding $name\n" if $::verbose > 1; + $name =~ s/\?/.?/g; + $name =~ s/\*/.*/g; + my @candidates = grep { $_ =~ /^$name$/ } keys %package; foreach (@candidates) { $action->($file, $_, $class) ; } } else { - $action->($file, $pkg, $class, $o_warn); + $action->($file, $name, $class, $o_warn); } } } } sub report_package_count() { - print " package count = ", scalar keys %package_class, "\n" if $::verbose > 1; + my @packages = grep { defined $package{$_}{class} } keys %package; + print " package count = ", scalar @packages, "\n" if $::verbose > 1; } 1; |