From 828b81547e606dd7dfeb6516df75db903d559c60 Mon Sep 17 00:00:00 2001 From: Martin Whitaker Date: Sat, 23 Dec 2017 10:10:05 +0000 Subject: Merge drakclassic media and files steps. --- drakclassic | 8 +- lib/MGA/DrakISO/BuildClassic.pm | 683 ---------------------------------------- lib/MGA/DrakISO/BuildMedia.pm | 679 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 682 insertions(+), 688 deletions(-) delete mode 100644 lib/MGA/DrakISO/BuildClassic.pm create mode 100644 lib/MGA/DrakISO/BuildMedia.pm diff --git a/drakclassic b/drakclassic index e8a5a4e..a4a88c8 100755 --- a/drakclassic +++ b/drakclassic @@ -33,7 +33,7 @@ use MGA::DrakISO::Config; use MGA::DrakISO::ClassicBuild; use MGA::DrakISO::Utils; -use MGA::DrakISO::BuildClassic; +use MGA::DrakISO::BuildMedia; use MGA::DrakISO::BuildBoot; use MGA::DrakISO::BuildISO; @@ -67,12 +67,11 @@ sub clean { my @actions = ( { name => 'dump-config', do => \&MGA::DrakISO::Config::dump_config }, { name => 'clean', do => \&clean }, - { name => 'media', do => \&MGA::DrakISO::BuildClassic::prepare_media }, - { name => 'files', do => \&MGA::DrakISO::BuildClassic::prepare_files }, + { name => 'media', do => \&MGA::DrakISO::BuildMedia::prepare_media }, { name => 'boot', do => \&MGA::DrakISO::BuildBoot::prepare_iso_bootloader }, { name => 'master', do => \&MGA::DrakISO::BuildISO::build_iso }, ); -my @all = qw(media files boot master); +my @all = qw(media boot master); my $build_object = 'MGA::DrakISO::ClassicBuild'->new; my $config_root = '/etc/drakclassic'; @@ -126,7 +125,6 @@ drakclassic [options] --help long help message --media prepare the installation media to be included on the ISO - --files prepare the other files to be included on the ISO --boot prepare installer boot and ISO bootloader files --master build master image diff --git a/lib/MGA/DrakISO/BuildClassic.pm b/lib/MGA/DrakISO/BuildClassic.pm deleted file mode 100644 index b276a71..0000000 --- a/lib/MGA/DrakISO/BuildClassic.pm +++ /dev/null @@ -1,683 +0,0 @@ -# Copyright (C) 2017 Mageia -# Martin Whitaker -# -# 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::BuildClassic; - -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); -} - -sub prepare_files { - my ($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; 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 +# +# 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; -- cgit v1.2.1