diff options
Diffstat (limited to 'lib/MGA/DrakISO/BuildMedia.pm')
| -rw-r--r-- | lib/MGA/DrakISO/BuildMedia.pm | 679 |
1 files changed, 679 insertions, 0 deletions
diff --git a/lib/MGA/DrakISO/BuildMedia.pm b/lib/MGA/DrakISO/BuildMedia.pm new file mode 100644 index 0000000..531c684 --- /dev/null +++ b/lib/MGA/DrakISO/BuildMedia.pm @@ -0,0 +1,679 @@ +# Copyright (C) 2017 Mageia +# Martin Whitaker <mageia@martin-whitaker.me.uk> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# SYNOPSIS +# -------- +# This module provides functions to create the installation media that will +# be used by the classic installer and to collect together the various other +# files that are needed on the installer ISO. + +package MGA::DrakISO::BuildMedia; + +use strict; + +use MDK::Common; +use common; +use URPM; + +use MGA::DrakISO::ClassicBuild; +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 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 the selected rpmsrate groups. The hash key is the +# group name and the hash value is the threshold for selecting packages +# in that group. +my %group_threshold; + +# 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; + +############################################################################### +# Main Code +############################################################################### + +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. + mkdir_p($build->get_builddir('tmp')); + + prepare_urpmi_media($build); + + get_known_conflicts($build); + + include_groups ($build, $build->{group_include_lists}); + exclude_packages($build, $build->{group_exclude_lists}); + update_dependencies($build); + + include_packages($build, $build->{package_include_lists}); + update_dependencies($build); + + exclude_packages($build, $build->{package_exclude_lists}); + update_dependencies($build); + + handle_conflicts($build); + + build_installer_media($build); + + my $arch = $build->{settings}{arch}; + my $version = $build->{settings}{version}; + my $tag = $build->{settings}{tag}; + + my $arch_dir = $build->get_builddir('files') . '/' . $arch; + + create_product_id($build, $arch_dir . '/product.id'); + create_index($build, $arch_dir . '/pkg-' . $version . '-' . $tag . '.idx'); +} + +############################################################################### +# URPM Setup +############################################################################### + +sub prepare_urpmi_media { + my ($build) = @_; + + # 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"); + foreach my $line (cat_($list_file)) { + chomp($line); + my ($name, $url) = split(' ', $line); + if ($name) { + $media{$name} = $url; + } + } + + # Now check the list of media specified by the user. + my %media_valid; + my $repo = $build->{settings}{repository}; + my $arch = $build->{settings}{arch}; + foreach my $class (@{$build->{repo}{classes}}) { + foreach my $type (@{$build->{repo}{types}}) { + my $name = $class . '-' . $type; + my $url = $repo . '/' . $arch . '/media/' . $class . '/' . $type; + if ($media{$name} eq $url) { + # This medium already exists, so we just need to make sure it + # is up to date. + run_urpm($build, "urpmi.update", $name); + } else { + if ($media{$name}) { + # A medium with this name but a different url already exists. + # We need to remove it before we can add the new one. + run_urpm($build, "urpmi.removemedia", $name); + } + # Add the requested medium. + run_urpm($build, "urpmi.addmedia", "--probe-synthesis $name $url"); + $media{$name} = $url; + } + $media_valid{$name} = 1; + } + } + + # Remove any media not in the user's list. + foreach my $name (keys %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'); +} + +############################################################################### +# Package Group Selection +############################################################################### + +sub include_groups { + my ($build, $file_list) = @_; + + # Read the lists of groups requested by the user. + foreach my $file (@$file_list) { + -f $file or die "ERROR: cannot open group list file '$file'\n"; + print "Including groups from $file\n" if $::verbose > 1; + my $line_number = 0; + foreach my $line (cat_($file)) { + chomp($line); + $line_number++; + my ($entry, $comment) = split('#', $line); + my ($name, $threshold) = split(' ', $entry); + next if !$name; # skip pure comment lines + if ($name =~ /^task-/) { + $package_class{$name} = 1; + } else { + $threshold >= 1 && $threshold <= 6 + or die "Invalid threshold for $name on line $line_number of '$file'\n"; + $group_threshold{$name} = $threshold; + } + } + } + + # Use the distribution rpmsrate file to select and add packages in the + # requested groups. + my $rpmsrate_src = $build->{settings}{repository} . '/' . $build->{settings}{arch} . '/media/media_info/rpmsrate'; + my $rpmsrate_tmp = $build->get_builddir('tmp') . '/rpmsrate'; + copy_or_link($rpmsrate_src, $rpmsrate_tmp); + add_rated_packages($build, $rpmsrate_tmp); + report_package_count(); +} + +# Partially derived from read_rpmsrate_raw in pkgs.pm. +sub add_rated_packages { + my ($build, $file) = @_; + + # Property records are two-element arrays. The first element is the + # indentation level of the property record. The second element is an + # array of property values which contains the accumulated property + # values for that indentation level. A property value is either a + # rating number (1 to 6) or a flag expression consisting of one or + # more flags, possibly qualified by the "!" operator, and separated + # by the "||" operator. The indentation level of the property record + # is the indentation level of the most indented property value in the + # array. + # + # Property records are collected as we read each line of the file, and + # retained until the initial indentation level of a new line is less + # than the indentation level of the record. + + my @property_records; + + my $line_number = 0; + foreach my $line (cat_($file)) { + $line_number++; + + # Use of hard tabs will confuse our calculation of indentation... + $line =~ /\t/ and die "ERROR: hard tab not allowed at $file line $line_number\n"; + + # Remove any comments. + $line =~ s/#.*//; + + # Split out any leading white space. This is the initial indent for + # the line. + my ($indent, $remaining) = $line =~ /(\s*)(.*)/; + + # Skip empty lines. + next if !$remaining; + + # Only retain the properties that are less indented than the current + # line. + @property_records = grep { $_->[0] < length($indent) } @property_records; + + # Inherit an initial set of property values from the last retained + # record (which should be the most indented of the retained records). + my @values = @property_records ? @{$property_records[-1][1]} : (); + + # Capture all the properties on this line. + my $consumed; # Most recently consumed portion of line. + my $value; # Most recently captured property value. + while ($remaining =~ + /^( + ( + [1-6] + | + (?: (?: !\s*)? [0-9A-Z_]+(?:".*?")?) + (?: \s*\|\|\s* (?: !\s*)? [0-9A-Z_]+(?:".*?")?)* + ) + (?:\s+|$) + )(.*)/x + ) { + ($consumed, $value, $remaining) = ($1,$2,$3); + + # Remove any non-quoted white space from the captured property + # value. + while ($value =~ s,^\s*(("[^"]*"|[^"\s]*)*)\s+,$1,) {} + + # Add a new property record and increase the indent each time we + # capture a value. + push @values, $value; + push @property_records, [ length($indent), [ @values ] ]; + $indent .= $consumed; + } + + # The remainder of the line (if any) is expected to be a list of + # package names, separated by white space. + if ($remaining) { + # Pull out the rating for the current indentation level. + my ($ratings, $flag_expressions) = partition { /^\d$/ } @values; + my ($rating) = @$ratings or die "ERROR: missing rating at $file line $line_number\n"; + + # In the installer, the set of flag expressions is treated as a + # list of conditions, all of which must be true for the package + # to be selected. But we need to include the packages for any + # possible selection of categories, so we need to determine + # whether any individual flag matches one of groups specified by + # the user and whether the package rating meets the specified + # threshold for that group. + my @flags = map { split('\|\|', $_) } @$flag_expressions; + + # Skip any architecture-specific packages that don't match our + # architecture. + my $arch = $build->{settings}{arch}; + next if $arch eq 'x86_64' && member('!TYPE"64bit"', @flags); + next if $arch ne 'x86_64' && member( 'TYPE"64bit"', @flags); + + # 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; + } + } + } +} + +############################################################################### +# Individual Package Selection +############################################################################### + +sub include_packages { + my ($build, $file_list) = @_; + + foreach my $file (@$file_list) { + print "Including packages from $file\n" if $::verbose; + update_package_selection($build, $file, \&add_to_selected_packages, 1, 'warn'); + report_package_count(); + } +} + +sub exclude_packages { + my ($build, $file_list) = @_; + + foreach my $file (@$file_list) { + print "Excluding packages from $file\n" if $::verbose; + update_package_selection($build, $file, \&remove_from_selected_packages, 0, 'warn'); + report_package_count(); + } +} + +############################################################################### +# Package Dependency Detection +############################################################################### + +sub update_dependencies { + my ($build) = @_; + + print "Calculating dependencies\n" if $::verbose; + + # Remove any existing dependencies. + my @dependencies = grep { $package_class{$_} == 2 } keys %package_class; + delete @package_class{@dependencies}; + + # Calculate the dependencies and update the package list. + my @packages = keys %package_class; + my $skip_list = %known_conflicts ? join(',', keys %known_conflicts) : ''; + 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 $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 @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 = %known_conflicts ? join(',', keys %known_conflicts) : ''; + 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); + } 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; + 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 ]); + } + } + 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) = @_; + + print "Checking for package conflicts and unsatisfied dependencies\n" if $::verbose > 1; + my $options = '-q --test --auto --ignoresize --no-verify-rpm'; + if ($o_skip_list) { + $options .= ' --skip ' . $o_skip_list; + } + run_urpm($build, 'urpmi', join(' ', $options, @$packages, '>', $log_file), 'not-fatal'); +} + +############################################################################### +# Installation Media Generation +############################################################################### + +sub build_installer_media { + my ($build) = @_; + + print "Building installer media\n" if $::verbose; + + # Create a clean set of media directories + my $arch = $build->{settings}{arch}; + my $arch_dir = $build->get_builddir('files') . '/' . $arch; + my $media_dir = $arch_dir . '/media/'; + rm_rf($media_dir) if -e $media_dir; + mkdir_p($media_dir . 'media_info'); + mkdir_p($media_dir . $_ . '/media_info') foreach @{$build->{repo}{classes}}; + + 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); + my $class = $path_parts[-3]; + my $name = $path_parts[-1]; + my $dst_file = $media_dir . $class . '/' . $name; + copy_or_link($src_file, $dst_file); + } + + print " generating media info\n" if $::verbose > 1; + + # Copy the pubkeys from the repository. Use the pubkeys from the first + # media type in each class. + my $repo_media_dir = $build->{settings}{repository} . '/' . $arch . '/media/'; + my $prime_type = ${$build->{repo}{types}}[0]; + foreach my $class (@{$build->{repo}{classes}}) { + my $pubkey = $repo_media_dir . $class . '/' . $prime_type . '/media_info/pubkey'; + copy_or_link($pubkey, $media_dir . $class . '/media_info/pubkey'); + } + + # Create the media config file. + create_media_cfg($build, $media_dir . 'media_info/media.cfg'); + + # Add files we can take directly from the source repository. + copy_or_link($repo_media_dir . '/media_info/compssUsers.pl', $media_dir . 'media_info/compssUsers.pl'); + copy_or_link($repo_media_dir . '/media_info/file-deps', $media_dir . 'media_info/file-deps'); + copy_or_link($repo_media_dir . '/media_info/rpmsrate', $media_dir . 'media_info/rpmsrate'); + + # Generate the remaining media info. + my $silent = $::verbose < 3 ? ' -s' : ''; + print "-- messages from gendistrib -----------------------\n" if !$silent; + system("gendistrib $silent $arch_dir\n") == 0 + or die "ERROR: gendistrib failed to generate the media info.\n"; + print "---------------------------------------------------\n" if !$silent; +} + +sub create_media_cfg { + my ($build, $file) = @_; + + my $version = $build->{settings}{version}; + my $branch = $build->{settings}{branch}; + my $arch = $build->{settings}{arch}; + + open(my $f, '>', $file); + print $f "[media_info]\n"; + print $f "mediacfg_version=2\n"; + print $f "version=$version\n"; + print $f "branch=$branch\n"; + print $f "arch=$arch\n"; + print $f "askmedia=1\n" if $build->{media_cfg}{askmedia}; + print $f "suppl=1\n" if $build->{media_cfg}{suppl}; + print $f "xml-info=1\n" if $build->{media_cfg}{xml_info}; + foreach my $class (@{$build->{repo}{classes}}) { + print $f "\n"; + print $f "[$class]\n"; + print $f "synthesis=../$class/media_info/synthesis.hdlist.cz\n"; + print $f "hdlist=../$class/media_info/hdlist.cz\n"; + print $f "pubkey=../$class/media_info/pubkey\n"; + print $f "name=" . ucfirst($class) . " Release (Installer)\n"; + } + close $f; +} + +############################################################################### +# Miscellaneous File Creation +############################################################################### + +sub create_product_id { + my ($build, $file) = @_; + + open(my $f, '>', $file); + print $f join(',', + 'vendor=' . $build->{settings}{vendor}, + 'distribution=' . $build->{settings}{distro}, + 'type=' . $build->{settings}{type}, + 'version=' . $build->{settings}{version}, + 'branch=' . $build->{settings}{branch}, + 'release=' . $build->{settings}{release}, + 'arch=' . $build->{settings}{arch}, + 'product=' . $build->{settings}{product} + ); + print $f "\n"; + close($f); +} + +# Derived from BCD::Genisoimage::create_idx +sub create_index { + my ($build, $file) = @_; + + my $arch = $build->{settings}{arch}; + + my $media_dir = $build->get_builddir($arch . '/media/'); + my @hdlists = glob("$media_dir/*/media_info/hdlist.cz"); + + my @tab; + my $urpm = URPM->new; + foreach (@hdlists) { + $urpm->parse_hdlist($_); + $urpm->traverse(sub { + my $pkg = shift; + my $pkgname = $pkg->name; + my $version = $pkg->version; + my $arch = $pkg->arch; + push @tab, "$pkgname-$version ($arch)"; + }); + } + + my %hashtab = map { $_ => 1 } @tab; + my @orderedpkgs = sort keys %hashtab; + + my $label = $build->{media}{label}; + + open(my $f, '>', $file); + foreach (@orderedpkgs) { + print $f "$label $_\n"; + } + close($f); +} + +############################################################################### +# Helper Functions +############################################################################### + +sub run_urpm { + my ($build, $cmd, $parameters, $o_not_fatal) = @_; + + 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)); + $error == 0 || $o_not_fatal or die "ERROR: $cmd command failed\n"; + $error; +} + +sub add_to_selected_packages { + my ($source, $pkg, $class, $o_warn) = @_; + + if ($package_class{$pkg}) { + print "WARNING <$source>: $pkg is already selected\n" if $o_warn; + } else { + print "INFO: Selecting package $pkg\n" if $::verbose > 2; + $package_class{$pkg} = $class; + } +} + +sub remove_from_selected_packages { + my ($source, $pkg, $class, $o_warn) = @_; + + if (defined $package_class{$pkg}) { + print "INFO: Deselecting package $pkg\n" if $::verbose > 2; + delete $package_class{$pkg}; + } else { + print "WARNING <$source>: $pkg is not currently selected\n" if $o_warn; + } +} + +sub update_package_selection { + my ($build, $file, $action, $class, $o_warn) = @_; + + -f $file or die "ERROR: cannot open package list file '$file'\n"; + foreach my $line (cat_($file)) { + chomp($line); + my ($data, $comment) = split('#', $line); + next if !$data; # skip pure comment lines + my @packages = split(' ', $data); + foreach my $pkg (@packages) { + my @alternatives = split('\|', $pkg); + if (@alternatives > 1) { + foreach my $alternative (@alternatives) { + $action->($file, $alternative, $class); + } + } elsif ($pkg =~ /-$/) { + print " expanding package $pkg\n" if $::verbose > 1; + my $available_list = $build->get_builddir('tmp') . '/pkg-available.lst'; + my @candidates = split('\n', `LC_ALL=C grep '^$pkg' $available_list`); + foreach (@candidates) { + $action->($file, $_, $class) ; + } + } else { + $action->($file, $pkg, $class, $o_warn); + } + } + } +} + +sub report_package_count() { + print " package count = ", scalar keys %package_class, "\n" if $::verbose > 1; +} + +1; |