Complete support for building classic installer ISOs.

4 files changed, 762 insertions, 17 deletions

diff --git a/drakclassic b/drakclassic
index b1c4c61..b0d7ff2 100755
--- a/drakclassic
+++ b/drakclassic
@@ -33,7 +33,7 @@ use MGA::DrakISO::Config;
 use MGA::DrakISO::ClassicBuild;
 use MGA::DrakISO::Utils;
 
-use MGA::DrakISO::BuildMedia;
+use MGA::DrakISO::BuildClassic;
 use MGA::DrakISO::BuildBoot;
 use MGA::DrakISO::BuildISO;
 
@@ -46,12 +46,6 @@ sub clean {
     rm_rf($_) foreach grep { -e $_ } $build->get_builddir, $build->get_system_root;
 }
 
-sub prepare_boot {
-    my ($build) = @_;
-    MGA::DrakISO::BuildBoot::prepare_classic_boot($build);
-    MGA::DrakISO::BuildBoot::prepare_iso_bootloader($build);
-}
-
 ###############################################################################
 # Main Program
 ###############################################################################
@@ -59,13 +53,12 @@ sub prepare_boot {
 my @actions = (
     { name => 'dump-config',    do => \&MGA::DrakISO::Config::dump_config },
     { name => 'clean',          do => \&clean },
-    { name => 'media',          do => \&MGA::DrakISO::BuildMedia::prepare_media },
-    { name => 'boot',           do => \&prepare_boot },
-    { name => 'boot-classic',   do => \&MGA::DrakISO::BuildBoot::prepare_classic_boot },
-    { name => 'boot-loader',    do => \&MGA::DrakISO::BuildBoot::prepare_iso_bootloader },
-    { name => 'master',         do => \&MGA::DrakISO::BuildISO::build_classic_iso },
+    { name => 'media',          do => \&MGA::DrakISO::BuildClassic::prepare_media },
+    { name => 'files',          do => \&MGA::DrakISO::BuildClassic::prepare_files },
+    { name => 'boot',           do => \&MGA::DrakISO::BuildBoot::prepare_iso_bootloader },
+    { name => 'master',         do => \&MGA::DrakISO::BuildISO::build_iso },
 );
-my @all = qw(media boot master);
+my @all = qw(media files boot master);
 
 die "you must be root to run this program\n" if $>;
 
@@ -91,6 +84,10 @@ require standalone;
     MGA::DrakISO::Config::check_config($build_object);
     MGA::DrakISO::Config::complete_config($build_object);
 
+    if ($build_object->{settings}{repository} =~ /^http:|^ftp:/) {
+        die "Sorry - remote repositories are not supported yet.";
+    }
+
     foreach (grep { $_->{to_run} } @actions) {
         print qq(* entering step "$_->{name}"\n);
         $_->{do}->($build_object);
@@ -115,6 +112,7 @@ 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
 
@@ -122,9 +120,6 @@ drakclassic [options]
 
    --clean           clean installation chroot and work directory
 
-   --boot-system     (for debug) prepare kernel and initrd for installer boot
-   --boot-loader     (for debug) prepare bootloader for ISO
-
    --config-root <dir>
                      root directory containing config and additional files
                      defaults to current directory if it contains a
diff --git a/lib/MGA/DrakISO/BuildClassic.pm b/lib/MGA/DrakISO/BuildClassic.pm
new file mode 100755
index 0000000..21c9cb2
--- /dev/null
+++ b/lib/MGA/DrakISO/BuildClassic.pm
@@ -0,0 +1,696 @@
+# 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::BuildClassic;
+
+use strict;
+
+use MDK::Common;
+use common;
+use URPM;
+
+use MGA::DrakISO::ClassicBuild;
+use MGA::DrakISO::Utils;
+
+###############################################################################
+# Global Variables
+###############################################################################
+
+my $force = 1;
+
+my $verbose = 1;
+
+# 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};
+
+    # Process the list of files or directories supplied by the user. If the
+    # repository is on a local disk, we just create soft links, otherwise
+    # we have to download the files.
+    my $repo_dir = $build->{settings}{repository} . '/' . $arch . '/';
+    my $copy_dir = $build->get_builddir . '/';
+    foreach (group_by2(@{$build->{copy_from_repo}})) {
+        my ($src, $dst) = @$_;
+        copy_or_link($repo_dir . $src, $copy_dir . $dst);
+    }
+
+    # Automatically generate the remaining files.
+    create_product_id($build, $copy_dir . $arch . '/product.id');
+    create_index($build, $copy_dir . $arch . '/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) {
+        die if !$force;
+        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($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/ClassicBuild.pm b/lib/MGA/DrakISO/ClassicBuild.pm
new file mode 100644
index 0000000..1a435fd
--- /dev/null
+++ b/lib/MGA/DrakISO/ClassicBuild.pm
@@ -0,0 +1,46 @@
+# Copyright (C) 2005 Mandriva
+#                    Olivier Blin <oblin@mandriva.com>
+# 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 package defines the ClassicBuild subclass that is used to hold all the
+# settings and configuration values needed to build a classic installer ISO.
+# It provides a number of helper functions over and above those provided by
+# the ISOBuild superclass.
+
+package MGA::DrakISO::ClassicBuild;
+
+use strict;
+
+use MDK::Common;
+
+use MGA::DrakISO::ISOBuild;
+
+our @ISA = qw(MGA::DrakISO::ISOBuild);
+
+sub new {
+    my ($class) = @_;
+    bless {}, $class;
+}
+
+sub default_name_fields {
+    [ qw(distro version product arch) ];
+}
+
+1;
diff --git a/lib/MGA/DrakISO/Utils.pm b/lib/MGA/DrakISO/Utils.pm
index ee1068f..c3533a4 100644
--- a/lib/MGA/DrakISO/Utils.pm
+++ b/lib/MGA/DrakISO/Utils.pm
@@ -30,7 +30,7 @@ use IO::Select;
 
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT = qw(directory_usage run_ mount_system_fs umount_external_fs);
+our @EXPORT = qw(directory_usage run_ copy_or_link mount_system_fs umount_external_fs);
 
 sub directory_usage {
     my ($dir, $o_apparent) = @_;
@@ -81,6 +81,14 @@ sub device_mkfs {
     }
 }
 
+sub copy_or_link {
+    my ($src_file, $dst_file) = @_;
+    # TODO: support remote sources.
+    mkdir_p(dirname($dst_file));
+    symlinkf($src_file, $dst_file)
+      or die "ERROR: couldn't link $src_file to $dst_file\n";
+}
+
 sub mount_system_fs {
     my ($build) = @_;
     run_('mount', '-t', 'devtmpfs', '/dev',  $build->get_system_root . '/dev');