summaryrefslogtreecommitdiffstats
path: root/lib/MGA/DrakISO/BuildClassic.pm
blob: 21c9cb25ce6822a19853eb9e986bcdc444f0eb50 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
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;