blends-dev 0.6.92.2 / usr / share / blends-dev / blend-gen-control

#!/usr/bin/perl
#
# Authors:
#       Petter Reinholdtsen <pere@hungry.com>
#       Andreas Tille <tille@debian.org>
# Date:   2001-08-23
#
# Generate the control file used by the Blend task package.

use warnings;
use strict;

use Getopt::Std;
use File::Path;

use vars qw(%opts %available %excluded %included @wanted %missing
            @tasks $debug $suppressempty);
my @arch = qw(alpha arm i386 ia64 m68k mips mipsel powerpc s390 sparc hppa);

my $debug           = 0;
my $nodepends       = 0;
my $ignoreapterrors = 0;
my $suppressempty   = 0;

my %taskinfo = ();
my $tasksdir = "tasks" ;
my $taskcontrolfile = "tasks.ctl" ;

my $aptsourcesdefaultlocation = "/etc/blends";
my $aptsources = $aptsourcesdefaultlocation . "/sources.list";
my $blend_dev_dir = "/usr/share/blends-dev";

my %commondepends ;
$commondepends{"adduser"}    = "0" ;
$commondepends{"debconf"}    = "1.2" ;
$commondepends{"menu"}       = "2.1.14" ;

my $CommonPackage = "" ;
my $prefix        = "test-" ;
my $blendname       = "" ;
my $blendshortname  = "" ;
my $tasksname     = "" ;
my $hasconfig     = 0 ;

sub usage() {
    print STDERR << "EOF";
blend-gen-control help screen
usage: $0 [options]

   -a               : print wanted packages
   -A               : ignore APT errors
   -c               : create new debian/control file
   -d               : print debug information
   -D               : lower all Depends: to Recommends:
   -e               : print excluded packages
   -h               : print this help screen and exit
   -i               :
   -m               : print missing packages
   -s <sourcefile>  : specify which sources.list file to use
   -S               : suppress tasks without any recommended package
   -t               : print task descriptions and package list for task

example: $0 -s sources.list.etch -D -c -m -i
EOF
}

getopts("cdaemis:StDhA", \%opts);

usage() and exit if $opts{'h'};

my $aptsourcesinput = $opts{'s'} if ($opts{'s'});
$aptsources = $aptsourcesinput ;
if ( $aptsources !~ m%^/% && $aptsources !~ /^sources\.list\./ ) { 
    my $cwd ;
    chomp($cwd = `pwd`) ;
    $aptsources = $cwd . "/sources.list." . $aptsources ;
}
if ( ! -e $aptsources ) {
    $aptsources = $aptsourcesdefaultlocation . "/sources.list." . $aptsourcesinput;
    if ( ! -e $aptsources ) {
	die "Apt sources.list $aptsources not found.\n" ;
    }
}

$debug           = 1 if ($opts{'d'});
$nodepends       = 1 if ($opts{'D'});
$ignoreapterrors = 1 if ($opts{'A'});
$suppressempty   = 1 if ($opts{'S'});

blend_init();

# print "$prefix ; $blendshortname ; $blendname ; $tasksname \n";

load_available_packages();

load_tasks();

# An ordered list of Blend tasks, in priority order of which are
# most needed on the CD. Only leaf tasks need be listed.
my @priorityorder = get_priorities("priority-high", 1);
my @medpriorder   = get_priorities("priority-med", 0);

# print "high: @priorityorder\nmed: @medpriorder\n" ;

if ($opts{'c'}) {
    gen_control();
} elsif ($opts{'e'}) {
    print_excluded_packages();
} elsif ($opts{'a'}) {
    print_all_packages();
} elsif ($opts{'t'}) {
    print_task_desc();
} else {
    print_available_packages();
}
print_missing_packages() if ($opts{'m'});

sub apt {
    my $op = shift;

    my $aptdir  = "../tmp/apt";
    # FIXME: For propper apt configuration see
    #        https://lists.debian.org/debian-mentors/2014/11/msg00032.html
    #        https://lists.debian.org/debian-mentors/2014/11/msg00033.html
    # For the moment to do only minimal changes in freeze time we set
    #        Dir::Etc::sourceparts=none
    # to prevent including random sources from users sources.list.d
    my @aptopts = ("Dir::Etc::sourcelist=$aptsources",
                   "Dir::Etc::sourceparts=none",
                   "Dir::State=$aptdir/state",
                   "Dir::Cache=$aptdir/cache",
                   "Dir::State::Status=/dev/null",
                   "Debug::NoLocking=true",
                   "APT::Get::AllowUnauthenticated=true");

    # Stupid apt-get and apt-cache do not understand the same arguments!
    # I have to map them to different formats to get both working.

    if ("update" eq $op) {
        mkpath "$aptdir/state/lists/partial";
        mkpath "$aptdir/cache/archives/partial";

        my $aptget   = "apt-get --assume-yes -o " . join(" -o ", @aptopts);

        print STDERR "aptget: $aptget\n" if $debug;
        if (system("$aptget update 1>&2")) {
            print STDERR "error: updating apt package lists failed\n";
            exit 1 unless $ignoreapterrors;
        }
    } elsif ("apt-cache" eq "$op") {
        my $aptcache = "apt-cache -o=" . join(" -o=", @aptopts);
        print STDERR "aptcache: $aptcache\n" if $debug;
        return $aptcache;
    }
}

sub sort_uniq {
    my $seen = shift;
    my @list;
    for my $entry (sort @_) {
        push @list,$entry unless $seen->{$entry};
        $seen->{$entry} = 1;
    }
    return @list;
}

sub uniq {
    my $seen = shift;
    my @list;
    for my $entry (@_) {
        push @list,$entry unless $seen->{$entry};
        $seen->{$entry} = 1;
    }
    return @list;
}

sub gen_control {
    my $task;
    for $task (sort keys %taskinfo) {
        next if (exists $taskinfo{$task}{'Metapackage'} &&
                        $taskinfo{$task}{'Metapackage'} eq 'false');

	print STDERR "$task: $taskinfo{$task}{'haspackages'}\n" if $debug;
	# if no package was found in the target distribution suppress this task at all
	if ( $suppressempty && $taskinfo{$task}{'haspackages'} == 0 ) {
	    print STDERR "The metapackage $task will not be created because $taskinfo{$task}{'haspackages'} dependant are in the pool and suppressempty was set ($suppressempty)\n" if $debug;
	    next ;
	}
        print "Package: $task\n";
	
	# metapackages should not be Section misc -> see #720199
	if (defined $taskinfo{$task}{'Section'} && $taskinfo{$task}{'Section'} ne 'misc') {
            print "Section: $taskinfo{$task}{'Section'}\n" ;
        } else {
            print "Section: metapackages\n" ;
        }
        my $header;
        for $header (qw(Architecture Priority)) {
            print "$header: $taskinfo{$task}{$header}\n"
                if (defined $taskinfo{$task}{$header});
        }
        my %seenlist;
        if ($nodepends) {
                # degrade dependencies to recommends
	        if ( $tasksname ) {
		    print "Depends: $tasksname";
		    if ( $tasksname =~ /-tasks$/ ) {
			print ' (= ${binary:Version})';
		    }
		    if ( $hasconfig ) {
			print ', ' . $prefix . 'config (= ${binary:Version})';
		    }
		    print "\n" ;
	        }
                # Use common %seenlist, as it is no use listing
                # packages both in recommends and suggest
                my @list;
                for $header (qw(Depends Recommends)) {
                    push (@list, @{$taskinfo{$task}{$header}})
                        if defined $taskinfo{$task}{$header};
                }
                my ($pkglist, $missinglist) = process_pkglist(join(",",@list));
                my (@recommends, @suggests);
                push @recommends, @{$pkglist};
                push @suggests, @{$missinglist};
#               push(@recommends, )
#                    if defined $taskinfo{$task}{Depends};
#               push(@recommends, )
#                   if defined $taskinfo{$task}{Recommends};
                push(@suggests, @{$taskinfo{$task}{Suggests}})
                    if defined $taskinfo{$task}{Suggests};
                print("Recommends: ",
                      join(",\n ", sort_uniq(\%seenlist, @recommends)),"\n")
                        if defined $taskinfo{$task}{Depends};
                print("Suggests: ",
                      join(",\n ", sort_uniq(\%seenlist, @suggests)),"\n")
                    if @suggests;
        }
        else {
                for $header (qw(Depends Recommends Suggests)) {
                    print "$header: ", join(",\n ", sort_uniq(\%seenlist, @{$taskinfo{$task}{$header}})),"\n"
                        if defined $taskinfo{$task}{$header};
                }
        }

        # Description Description-long
        print "Description: $taskinfo{$task}{Description}\n";
        print "$taskinfo{$task}{'Description-long'}"; # Already contain newline

        print "\n";
    }
}

# List all depends, recommends and suggests packages as task packages.
# Optionally, list depends as key packages, and the rest as task
# packages.
# Enable to list all dependencies as key packages
my $task_depends_are_keys = 0;
sub print_task_desc {
        foreach my $task (sort keys %taskinfo) {
                next if (exists $taskinfo{$task}{'Leaf'} &&
                        $taskinfo{$task}{'Leaf'} eq 'false');
		my $header;
		if ( $suppressempty && $taskinfo{$task}{'haspackages'} == 0 ) {
		    # Check for Test-always-lang header.  If this field exists the
		    # task should be created even if there are no explicite dependencies
		    # This is a request of Debian Edu (see the thread at
		    # http://lists.debian.org/debian-blends/2009/04/msg00008.html
		    my $foundflag = 0;
		    for $header (keys %{$taskinfo{$task}}) {
			if ($header =~ m/Test-always-lang/) {
			    print STDERR "Print empty task $task because Test-always-lang is set\n" if $debug;
			    $foundflag = 1;
			    last;
			}
		    }
		    if ( $foundflag == 0 ) {
			print STDERR "The metapackage $task will not be created because $taskinfo{$task}{'haspackages'} dependant are in the pool and suppressempty was set ($suppressempty)\n" if $debug;
			next ;
		    }
		}
                print "Task: $task\n";
                print "Section: $blendname\n";
                print "Description: $taskinfo{$task}{Description}\n";
                print "$taskinfo{$task}{'Description-long'}"; # Already contain newline
                print "Relevance: 10\n";
                print "Enhances: $taskinfo{$task}{Enhances}\n"
                    if exists $taskinfo{$task}{Enhances};
                for $header (keys %{$taskinfo{$task}}) {
                    if ($header =~ m/test-.+/i) {
                        print "$header: $taskinfo{$task}{$header}\n";
                    }
                }
                unless (exists $taskinfo{$task}{'Metapackage'} &&
                        $taskinfo{$task}{'Metapackage'} eq 'false') {
                    # No use listing a metapackage as a key package, if no metapackage exist.
                    print "Key: \n";
                    print " $task\n";
                }
                my %seen;
                $seen{$task} = 1;
                if ($task_depends_are_keys) {
                    foreach my $package (task_packages($task, "Depends")) {
                        print " $package\n" unless $seen{$package};
                        $seen{$package} = 1;
                    }
                }
                print "Packages: list\n";
                for my $header (qw(Depends Recommends)) {
                    foreach my $package (task_packages($task, $header, 1)) {
                        print " $package\n" unless $seen{$package};
                        $seen{$package} = 1;
                    }
                }

                print "\n";
        }
}

sub select_alternative {
    my $pkglist = shift;
    return $pkglist;
}

sub task_packages {
        my ($task, $header, $includealldeps) = @_;
        my @packages = $task;
        foreach my $package (@{$taskinfo{$task}{$header}}) {
                if ($package=~/\|/) {
                        # Tasksel doesn't allow boolean or-ing of
                        # dependencies. Just take the first one that is
                        # available.
                        my $ok=0;
                        foreach my $alternative (split(' | ', $package)) {
                                if (! exists $taskinfo{$alternative} &&
                                    ! exists $available{$alternative}) {
                                        if (! exists $missing{$alternative}) {
                                                $missing{$alternative} = 1;
                                        }
                                }
                                else {
                                        print STDERR "task_packages: choosing $alternative from $package\n" if $debug;
                                        $package=$alternative;
                                        $ok=1;
                                        last;
                                }
                        }
                        if (! $ok) {
                                next;
                        }
                }
                if (exists $taskinfo{$package}) {
                        # Add packages from task recursively, since
                        # tasksel does not support dependent tasks of
                        # the type used by Blend
                        if (defined $includealldeps && $includealldeps) {
                                for my $h (qw(Depends Recommends)) {

                                        push(@packages, $package,
                                             task_packages($package, $h, 1));
                            }
                        } else {
                                push(@packages, $package,
                                     task_packages($package, $header));
                        }
                }
                else {
                        push @packages, $package;
                }
        }
        return @packages;  ### FIXME!: insert sort here to enable sorted list inside tasks control file (tested on 2014-11-03 but do not touch in freeze time)
}

#
# Check the APT cache, and find the packages currently available.
#
sub load_available_packages
{
    apt("update");
    my $aptcache = apt("apt-cache");
    open(APT, "$aptcache dump |") || die "Unable to start apt-cache";
    my $pkg;
    while (<APT>) {
        chomp;
        if (/^Package: (.+)$/) {
            $pkg = $1;
            print STDERR "Found pkg '$pkg'\n" if $debug;
        }
        if (/^\s+Version:\s+(.+)/) {
            print STDERR " pkg $pkg = ver $1\n" if $debug;
#           print "C: $pkg $available{$pkg} lt $1\n" if ( exists $available{$pkg});
            $available{$pkg} = $1 if ( ! exists $available{$pkg} ||
                                       $available{$pkg} lt $1 );
        }
    }
}

#
# Load all tasks
#
sub load_tasks {
    my $taskfile;

    # First document their existence, so they can depend on each other.
    for $taskfile (<tasks/*>) {
        next if (($taskfile eq "tasks/CVS") || ($taskfile eq "tasks/.svn"));
        next if ($taskfile =~ m/~$/);

        my $curpkg = $taskfile;
        $curpkg =~ s%tasks/%$prefix%;
        $available{$curpkg} = "n/a";

        push(@tasks, "$taskfile:$curpkg");
    }

    # Next, load their content.
    my $foo;
    for $foo (@tasks) {
        my ($taskfile, $curpkg) = $foo =~ m/^(.+):(.+)$/;
        next if ("tasks/CVS" eq $taskfile);

        load_task($taskfile, $curpkg);
    }
}

sub process_pkglist {
    my $pkgstring = shift;
    my @pkglist = ();
    my @missinglist = ();
    my $packages;
    for $packages (split(/\s*,\s*/, $pkgstring)) {
        print "E: double comma?: $_\n" if ($packages =~ /^\s*$/ && $debug);
        my $package;
        my @alternates=split(/\s*\|\s*/, $packages);
        my $alternatecount=0;
        for $package (@alternates) {
            print STDERR "Loading pkg '$package'\n" if $debug;
	    if ($package =~ /[A-Z]/) {
		print STDERR "Packages may not contain upper case letters (policy 5.6.7) $package. Name will be turned into ";
		$package = lc($package);
		print STDERR "$package\n";
	    }
            if ($package =~ /^-(.+)$/) {
                $excluded{$1} = 1;
            } elsif ( !exists $available{$package} ) {
                if ( !exists $missing{$package}) {
                    $missing{$package} = 1;
                }
                push(@missinglist, $package);
            } else {
                if ($alternatecount == 0) {
                    #push(@pkglist, $package) if (! exists $pkglist[$package]);
                    push(@pkglist, $package);
                }
                else {
                    $pkglist[-1].=" | $package";
                }
                $alternatecount++;

                if ( ! $included{$package} ) {
                    push(@wanted, $package);
                    $included{$package} = 1;
                }
            }
        }
    }
    return (\@pkglist, \@missinglist);
}

sub load_task {
    my ($taskfile, $curpkg) = @_;
    open(TASKFILE, "<$taskfile") || die "Unable to open $taskfile";
    my $line;

    $taskinfo{$curpkg} = ();

    print STDERR "Loading task $curpkg\n" if $debug;

    my $haspackages = 0;
    while (<TASKFILE>) {
        chomp;
        next if (m/^\#/); # Skip comments
        $line = $_;

        # Append multi-line
        while ($line =~ /\\$/) {
            $line =~ s/\s*\\//;
            $_ = <TASKFILE>;
            chomp;
            $line .= $_;
        }
        # Remove trailing space
        $line =~ s/\s+$//;

        $_ = $line;
        for my $header (qw(Section Architecture Priority Leaf Enhances Metapackage)) {
            $taskinfo{$curpkg}{$header} = $1 if (m/^$header:\s+(.+)$/);
        }
        $taskinfo{$curpkg}{$1} = $2 if (m/^(test-.+):\s+(.+)$/i);

        if (m/^Description:\s+(.+)$/) {
            $taskinfo{$curpkg}{'Description'} = $1;
            $taskinfo{$curpkg}{'Description-long'} = "";
            while (<TASKFILE>) {
                # End of description, pass next line to pattern matching
                last if (m/^\S+/ || m/^\s*$/);

                $taskinfo{$curpkg}{'Description-long'} .= $_;
            }
        }

        next unless defined $_;

        my $header;
        for $header (qw(Depends Recommends Suggests)) {
            if (m/^$header:\s+(.+)$/ && $1 !~ /^\s*$/) {
                $taskinfo{$curpkg}{$header} = ()
                    if (! exists $taskinfo{$curpkg}{$header});
                my ($pkglist, $missinglist) = process_pkglist($1);
                push(@{$taskinfo{$curpkg}{$header}}, @{$pkglist});

		$haspackages += $#{$taskinfo{$curpkg}{$header}} + 1;
		print STDERR "$curpkg $header:", @{$taskinfo{$curpkg}{$header}}, "($haspackages)\n" if $debug;
                # Avoid missing packages in Depends lists, allow them
                # in the two others.  Insert missing depends in
                # suggests list.
                if (@{$missinglist}) {
		    print STDERR "$curpkg: missing = ", @{$missinglist}, "\n" if $debug;
                    if ("Depends" eq $header) {
                        push(@{$taskinfo{$curpkg}{'Suggests'}}, @{$missinglist});
                    } else {
                        push(@{$taskinfo{$curpkg}{$header}}, @{$missinglist});
                    }
                }
            }
        }

        if (/^Avoid:\s+(.+)$/) {
            my @pkgs = split(/\s*,\s*/, $1);
            my $packages;
            for $packages (@pkgs) {
                my $package;
                for $package (split(/\s*\|\s*/, $packages)) {
                    $excluded{$package} = 1;
                }
            }
        }

        if (/^Ignore:\s+(.+)$/) {
            my @pkgs = split(/\s*,\s*/, $1);
            my $packages;
            for $packages (@pkgs) {
                my $package;
                for $package (split(/\s*\|\s*/, $packages)) {
                    # Remove explanations, ie the paranteses at the end.
                    $package =~ s/\s*\([^\)]*\)\s*$//;
                    $missing{$package} = 1;
                }
            }
        }
    }
    close(TASKFILE);
    unless ( $taskinfo{$curpkg}{'Architecture'} ) { $taskinfo{$curpkg}{'Architecture'} = "all" ; }
    $taskinfo{$curpkg}{'haspackages'} = $haspackages; 
    print STDERR "$curpkg: haspackages = ", $taskinfo{$curpkg}{'haspackages'}, "\n" if $debug;
}

sub print_excluded_packages {
    print join("\n", sort keys %excluded),"\n";
}

sub print_available_packages {
    print join("\n", @wanted),"\n";
}

sub print_all_pkgs_tasks {
    my ($seenref, $headerlistref, @tasks) = @_;

    my @headers;
    if ( $headerlistref ) {
      @headers = @{$headerlistref};
    } else {
      @headers = qw(Depends Recommends Suggests)
    }

    for my $header (@headers) {
        print STDERR "  Processing $header\n" if $debug;
        my %seentask;
        for my $task (@tasks) {
            next if $seentask{$task};
            $seentask{$task} = 1;

            print "# printing $header in $task\n";
            print STDERR "   Printing $task\n" if $debug;

            # Pick the first available if there are alternatives
            my @pkgs = uniq($seenref, task_packages($task, $header), $task);
            print join("\n", @pkgs), "\n" if @pkgs;
        }
    }
}

sub print_all_packages {
    print STDERR "Printing all packages\n" if $debug;
#    print join("\n", @wanted, keys %missing),"\n";

    print "# First process the high priority tasks\n";
    my %seenlist;
    print_all_pkgs_tasks(\%seenlist, [qw(Depends Recommends)], @priorityorder );

    print "# Next, medium priority tasks tasks\n";
    print_all_pkgs_tasks(\%seenlist, [qw(Depends Recommends)], @medpriorder );

    print "# Next process all the others, in alphabetic order\n";
    print_all_pkgs_tasks(\%seenlist, undef, sort keys %taskinfo);

    print "# And last, the alternatives we dropped above\n";
    print join("\n", uniq(\%seenlist, @wanted, sort keys %missing)),"\n";
}

sub print_missing_packages {
    if (%missing) {
        print STDERR "Missing or avoided packages:\n";
        my $package;
        for $package (sort keys %missing) {
            if (exists $available{$package}) {
                print STDERR "  $package (v$available{$package} available)\n";
            } else {
                print STDERR "  $package\n";
            }
        }
        exit 1 unless $opts{'i'};
    }
}

## Additions by Andreas Tille

sub get_priorities {
    my ($prio, $default) = @_;
    my @list = () ;

    # if there is no taskcontrolfile every task has the same priority
    if ( ! stat($taskcontrolfile) ) {
	if ( ! $default ) { return (); }
        print STDERR "No task control file found - setting all tasks priority high.\n" if $debug;
	opendir(DIR, $tasksdir) || die("No tasks directory found.");
        @list = grep { !/^\./ } readdir(DIR);
        closedir DIR;
	return @list;
    }
    # read taskcontrolfile and find priorities
    print STDERR "Reading task control file.\n" if $debug;
    open(PRIO,$taskcontrolfile) || die("Unable to read task control file.");
    while (<PRIO>) {
        chomp ;
	if ( $_=~/^$prio\s*:\s*([-\w]+)/) {	
	    push @list,$1;
        }
    }
    close PRIO;

    return @list;
}

sub blend_init {
    # initialise blend name and other basic stuff
    unless  ( -d "debian" ) {
	mkdir("debian") || die "mkdir debian: $!";
    }

    unless ( -e "debian/control.stub" ) {
        print STDERR "No template debian/control.stub.  Use test prefix.\n" ;
    } else {
        chomp($prefix = `$blend_dev_dir/blend-get-names metapackageprefix`) ;
        $prefix = $prefix . "-" ;
	$tasksname    = $prefix . "tasks";
	chomp($blendshortname = `$blend_dev_dir/blend-get-names blendshortname`);
	chomp($blendname      = `$blend_dev_dir/blend-get-names blendname`);
    }
    if  ( -d "config" && -e "config/control" ) {
	$hasconfig = 1;
    }
}