ubuntu-dev-tools/pull-debian-debdiff

#!/usr/bin/perl
#
# Copyright 2007-2008 Kees Cook <kees@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;

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

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

    # Parse the .dsc file for list of required files...
    my @needed;
    open(DSC,"$file") || return 0;
    while (my $line=<DSC>) {
        if ($line =~ /^Files:/) {
            while (my $file=<DSC>) {
                chomp($file);
                last if ($file !~ /^ /);
                my @parts = split(/\s+/,$file);
                my $want = pop(@parts);
                print "Want '$want'\n";
                push(@needed,$want);
            }
        }
    }
    close(DSC);

    foreach my $file (@needed) {
        if (! -r "$file") {
            warn "Pulling $urlbase/$file ...\n";
            system("wget $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);

    # Attempt to pull from security updates first
    $urlbase = "http://security.debian.org/pool/updates/$base";

    if (!geturls($urlbase,$pkg,$version)) {
        # Try regular pool

        $urlbase = "http://ftp.debian.org/debian/pool/$base";
        if (!geturls($urlbase,$pkg,$version)) {
            # Try snapshot

            $urlbase="http://snapshot.debian.net/package/$pkg/$version";
            warn "Fetching snapshot url via '$urlbase' ...\n";
            $urlbase=`curl -sI 'http://snapshot.debian.net/package/$pkg/$version' | grep ^[lL]ocation | cut -d' ' -f2 | head -1`;
            $urlbase =~ s/[\r\n]//g;
            warn "Trying snapshot location '$urlbase' ...\n";

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

    return 1;
}



my $pkg = $ARGV[0];
my $version = $ARGV[1];
my $just_fetch = ($ARGV[2] && $ARGV[2] eq "--fetch");
my $skip = $ARGV[2] || 1;
$skip+=0;

if (!defined($pkg) || !defined($version)) {
    die "Usage: $0 PKG VERSION\n";
}


# 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";