/usr/bin/xt-guess-suite-and-mirror

#!/usr/bin/perl -w

=encoding utf8

=head1 NAME

xt-guess-suite-and-mirror - Tries to guess the most suitable suite and
mirror for DomUs on Debian and Ubuntu Dom0s.

=head1 SYNOPSIS

  --suite       Show suite
  --mirror      Show mirror

  Shows both if no parameter is given.

  Help Options:

   --help       Show the help information for this script.
   --manual     Show the manual for this script.
   --version    Show the version number and exit.


=head1 DESCRIPTION

xt-guess-suite-and-mirror tries to find the mirror and suite the Xen
Dom0 is currently using and returns them in a way suitable for
xen-create-image(1) or the backticks feature in xen-tools.conf.


=head1 AUTHORS

 Axel Beckert, http://noone.org/abe/
 Stéphane Jourdois


=head1 LICENSE

Copyright (C) 2010-2012 by The Xen-Tools Development Team. All rights
reserved.

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. The LICENSE file contains the
full text of the license.

=cut

###
### Configuration
###

# Fallback to Debian or Ubuntu in case we can't find anything
my $fallback = 'Debian';

# Which mirrors to use if everything else fails (httpredir.debian.org
# redirects to a working mirror nearby)
my %fallback_mirror = ( Debian => 'http://httpredir.debian.org/debian/',
                        Ubuntu => 'http://archive.ubuntu.com/ubuntu/' );

# Which suite to use if everything else fails. For Debian "stable"
# should be the best choice independent of the time. Ubuntu does not
# have aliases like stable or testing, so we take the nearest LTS
# release which is 10.04 at the time of writing.
my %fallback_suite = ( Debian => 'stable',
                       Ubuntu => 'lucid' );

# Where to look for the sources.list to parse
my @sources_list_files = ( '/etc/apt/sources.list',
                           glob('/etc/apt/sources.list.d/*.list'));

use File::Slurp;
use Getopt::Long;
use Pod::Usage;
use File::Which;

use strict;


#
# Release number.
#
my $RELEASE = '4.6.2';

# Init
my $mirror = '';
my $suite = '';
my $found = 0;

# Parsing command line options
my $want_mirror  = 0;
my $want_suite   = 0;
my $want_version = 0;
my $want_help    = 0;
my $want_manual  = 0;

my $result = GetOptions( 'mirror|m' => \$want_mirror,
                         'suite|s'  => \$want_suite,
                         'version'  => \$want_version,
                         'manual'   => \$want_manual,
                         'help'     => \$want_help );

if ($want_help) {
    pod2usage(0);
}

if ($want_manual) {
    pod2usage( -verbose => 2 );
}

all_sources_list_files: foreach my $sources_list_file (@sources_list_files) {
    if (-r $sources_list_file) {
        # sources.list file exists, so it's something debianoid.

        # read sources.list and split it into lines
        my @sources_list = read_file($sources_list_file);

        # Find the first line which is a Debian or Ubuntu mirror but not
        # an updates, backports, volatile or security mirror.
        foreach my $sources_list_entry (@sources_list) {
            # Normalize line
            chomp($sources_list_entry);
            $sources_list_entry =~ s/^\s*(.*?)\s*$/$1/;

            # Skip definite non-entries
            next if $sources_list_entry =~ /^\s*($|#)/;

            # Split up into fields
            my @source_components = split(/\s+/, $sources_list_entry);

            # Minimum number of components is 4
            next if $#source_components < 3;

            # Don't use deb-src entries.
            next if $source_components[0] eq 'deb-src';

            # Skip updates, backports, volatile or security mirror.
            next if $source_components[2] !~ /^[a-z]+$/;

            if ($source_components[1] =~ m(/debian/?$|/ubuntu/?$)) {
                # Seems a typical mirror. Let's use that one

                $mirror = $source_components[1];
                $suite = $source_components[2];

                $found = 1;
                last all_sources_list_files;
            }
        }
    }
}
die "Couldn't find a useful entry in the sources.list files of the Dom0. Tried:\n  ".
    join("\n  ", @sources_list_files)."\n" unless $found;

my $lsb_release = which('lsb_release');
if (!$found and defined($lsb_release) and -x $lsb_release) {
    my $vendor = `$lsb_release -s -i`;

    if ($vendor eq 'Debian' or $vendor eq 'Ubuntu') {
        $suite = `$lsb_release -s -c`;
        chomp($suite);

        unless ($suite) {
            $suite = $fallback_suite{$vendor};
            warn "Dom0 seems to be $vendor, but couldn't determine suite. Falling back to $suite.\n";
        }

        $mirror = $fallback_mirror{$vendor};

        $found = 1;
    }
}

if ($found) {
    unless ($want_help || $want_version || $want_suite || $want_mirror) {
        print "$mirror $suite\n";
    } else {
        if ($want_mirror) {
            print "$mirror";
        }
        if ($want_suite) {
            print "$suite";
        }
        print "\n";
    }
} else {
    $suite  = $fallback_suite{$fallback};
    $mirror = $fallback_mirror{$fallback};
}
xen-tools 4.6.2-1 / usr / bin / xt-guess-suite-and-mirror
