ubuntu-dev-tools/pull-debian-debdiff

#!/usr/bin/perl
#
# Copyright 2007-2008, Kees Cook <kees@ubuntu.com>,
#                2010, Stefano Rivera <stefanor@ubuntu.com>
#
# ##################################################################
#
# 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 3
# of the License, 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.
#
# See file /usr/share/common-licenses/GPL for more details.
#
# ##################################################################
#
# This script attempts to find and download a specific version of a Debian
# package and its immediate parent to generate a debdiff.
#
# Requirements: devscripts diffstat dpkg-dev

use strict;
use warnings;
use File::Basename;
use Getopt::Long;
use LWP::Simple;

die("Please install 'devscripts'\n") if(! grep -x "$_/dget", split(':',$ENV{'PATH'}));

my($debmirror, $debsecmirror, $no_fallback);

sub geturls
{
    my ($urlbase,$pkg,$version)=@_;
    my $file;

    $file = "${pkg}_${version}.dsc";
    print "Want '$file'\n";
    system("dget -du $urlbase/$file");
    return 0 if ($? != 0);
    return 1;
}

sub generate_base
{
    my ($pkg)=@_;

    my @path;
    push(@path,"main");
    if ($pkg =~ /^(lib.)/) {
        push(@path,$1);
    }
    else {
        push(@path,substr($pkg,0,1));
    }
    push(@path,$pkg);
    return join("/",@path);
}

sub download_source
{
    my ($pkg,$version)=@_;
    my $urlbase;

    my $base = generate_base($pkg);

    my $defdebmirror = 'http://ftp.debian.org/debian';
    my $defdebsecmirror = 'http://security.debian.org';

    my @mirrors;
    # Attempt to pull from security updates first
    push @mirrors, "$debsecmirror/pool/updates/$base" if $debsecmirror;
    push @mirrors, "$defdebsecmirror/pool/updates/$base"
            if $debsecmirror ne $defdebsecmirror and !$no_fallback;
    # Try regular pool:
    push @mirrors, "$debmirror/pool/$base" if $debmirror;
    push @mirrors, "$defdebmirror/pool/$base"
            if $debmirror ne $defdebmirror and !$no_fallback;

    foreach $urlbase (@mirrors) {
        return 1 if geturls($urlbase, $pkg, $version);
    }

    # Try snapshot:
    $urlbase="http://snapshot.debian.net/package/$pkg/$version";
    warn "Fetching snapshot url via '$urlbase' ...\n";
    my $scrape=get('http://snapshot.debian.net/package/$pkg/$version/');
    $scrape =~ /a href=\"()
    $urlbase =~ /
    $urlbase =~ s/[\r\n]//g;
    warn "Trying snapshot location '$urlbase' ...\n";

    if ($urlbase ne "" && !geturls($urlbase,$pkg,$version)) {
        return 0;
    }

    return 1;
}

sub usage
{
    my ($exit) = @_;
    my ($name) = basename($0);
    print <<"EOF";
Usage: $name [options] PKG VERSION [DISTANCE]

Attempts to find and download version VERSION of Debian package PKG and its
immediate parent to generate a debdiff.
If DISTANCE is specified, the debdiff is against DISTANCE versions before
VERSION.

Options:
  -h, --help            Show this help message and exit
  -f, --fetch           Only fetch the source packages, don't diff.
  -d DEBMIRROR, --debmirror=DEBMIRROR
                        Preferred Debian mirror
                        (default: http://ftp.debian.org/debian)
  -s DEBSECMIRROR, --debsecmirror=DEBSECMIRROR
                        Preferred Debian Security mirror
                        (default: http://security.debian.org)
  -n, --no-fallback     If a custom mirror is provided and an error occurs
                        while downloading, don't fall back to the default
  --no-conf             Don't read config files or environment variables
EOF
    exit $exit;
}


my($help, $just_fetch, $no_conf);
GetOptions('h|help' => \$help,
           'f|fetch' => \$just_fetch,
           'd|debmirror=s' => \$debmirror,
           's|debsecmirror=s' => \$debsecmirror,
           'n|no-fallback' => \$no_fallback,
           'no-conf' => \$no_conf,
          );

my $pkg = $ARGV[0];
my $version = $ARGV[1];
my $skip = $ARGV[2] || 1;
$skip += 0;

if ($help) {
    usage(0);
} elsif (!defined($pkg) || !defined($version)) {
    usage(2);
}

# Read configuration files
if (! $no_conf) {
    my($shell_cmd);
    $shell_cmd .= "[ -f /etc/devscripts.conf ] && . /etc/devscripts.conf\n";
    $shell_cmd .= "[ -f ~/.devscripts ] && . ~/.devscripts\n";
    foreach my $var qw(PULL_DEBIAN_DEBDIFF_DEBMIRROR UBUNTUTOOLS_DEBMIRROR
                       PULL_DEBIAN_DEBDIFF_DEBSECMIRROR
                       UBUNTUTOOLS_DEBSECMIRROR
                       PULL_DEBIAN_DEBDIFF_MIRROR_FALLBACK
                       UBUNTUTOOLS_MIRROR_FALLBACK) {
        $shell_cmd .= "echo $var=\$$var\n";
    }
    my $shell_out = `/bin/bash -c '$shell_cmd'`;
    my %config_values;
    foreach my $line (split /\n/, $shell_out) {
        my($k, $v) = split /=/, $line, 2;
        $config_values{$k} = $v;
    }
    $debmirror = $config_values{'PULL_DEBIAN_DEBDIFF_DEBMIRROR'}
                 || $config_values{'UBUNTUTOOLS_DEBMIRROR'}
                 if (! $debmirror);
    $debsecmirror = $config_values{'PULL_DEBIAN_DEBDIFF_DEBSECMIRROR'}
                    || $config_values{'UBUNTUTOOLS_DEBSECMIRROR'}
                    if (! $debsecmirror);
    if (! $no_fallback) {
        my($v) = $config_values{'PULL_DEBIAN_DEBDIFF_MIRROR_FALLBACK'}
                 || $config_values{'UBUNTUTOOLS_MIRROR_FALLBACK'};
        $no_fallback = 1 if $v eq "no";
    }
}

# Extract latest source
die "Cannot locate $pkg $version\n" unless download_source($pkg,$version);
exit(0) if ($just_fetch);
system("dpkg-source -x ${pkg}_${version}.dsc");
die "Unpack of $pkg $version failed\n" unless ($? == 0);

# Locate prior changelog entry
my $prev_ver;
my $upstream_version = $version;
if ($upstream_version =~ /^([^-]+)-/) {
    $upstream_version = $1;
}
my $srcdir="$pkg-$upstream_version";
if (! -d "$srcdir") {
    undef $srcdir;
    my $dir;
    opendir(DIR,".");
    while ($dir = readdir(DIR)) {
        if ($dir =~ /^${pkg}-/ && -d $dir) {
            $srcdir = $dir;
            last;
        }
    }
    closedir(DIR);
}
die "Cannot locate source tree\n" if (!defined($srcdir));
my $log = "$srcdir/debian/changelog";
open(LOG,"<$log") || die "$log: $!\n";
while (my $line=<LOG>) {
    if ($line =~ /^$pkg \((?:\d+:)?([^\)]+)\)/) {
        my $seen = $1;
        if ($seen ne $version) {
            $skip--;

            if ($skip==0) {
                $prev_ver=$seen;
                last;
            }
        }
    }
}
close(LOG);
die "Cannot find earlier source version\n" if (!defined($prev_ver));

die "Cannot locate $pkg $prev_ver\n" unless download_source($pkg,$prev_ver);
#system("dpkg-source -x ${pkg}_${prev_ver}.dsc");
#die "Unpack of $pkg $prev_ver failed\n" unless ($? == 0);

system("debdiff ${pkg}_${prev_ver}.dsc ${pkg}_${version}.dsc > ${pkg}_${version}.debdiff");
die "Cannot debdiff\n" unless ($? == 0);

system("diffstat -p0 ${pkg}_${version}.debdiff");
print "${pkg}_${version}.debdiff\n";